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

gcc/ada/ChangeLog

+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,

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;
 
+      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;

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;

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;
 
    --------------

gcc/ada/scng.adb

@@ -2412,13 +2412,18 @@ 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
+                  if Inside_Conditional_Expression = 0 then
                      Style.Check_Separate_Stmt_Lines;
                   end if;
                end if;
+            end if;
 
             --  We must reset Token_Name since this is not an identifier and
             --  if we leave Token_Name set, the parser gets confused because
@@ -2550,7 +2555,6 @@ package body Scng is
          else
             exit Tabs_Loop;
          end if;
-
       end loop Tabs_Loop;
 
       return Start_Column;

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);
+
+      if Present (Else_Expr) then
          Analyze_Expression (Else_Expr);
+      end if;
+
       Set_Etype (N, Etype (Then_Expr));
    end Analyze_Conditional_Expression;
 

gcc/ada/sem_res.adb

@@ -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);
+
+      --  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;

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

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);