g-awk.adb (Default_Session, [...]): Compile this file in Ada 95 mode, because it violates the new rules for AI-318.

2006-10-31  Bob Duff  <duff@adacore.com>
	    Robert Dewar  <dewar@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* g-awk.adb (Default_Session, Current_Session): Compile this file in
	Ada 95 mode, because it violates the new rules for AI-318.

	* g-awk.ads: Use overloaded subprograms in every case where we used to
	have a default of Current_Session. This makes the code closer to be
	correct for both Ada 95 and 2005.

	* g-moreex.adb (Occurrence): Turn off warnings for illegal-in-Ada-2005
	code, relying on the fact that the compiler generates a warning
	instead of an error in -gnatg mode.

	* lib-xref.ads (Xref_Entity_Letters): Add entry for new
	E_Return_Statement entity kind.
	Add an entry for E_Incomplete_Subtype in Xref_Entity_Letters.

	* par.adb (P_Interface_Type_Definition): Addition of one formal to
	report an error if the reserved word abstract has been previously found.
	(SS_End_Type): Add E_Return for new extended_return_statement syntax.
        
        * par-ch4.adb (P_Aggregate_Or_Paren_Expr): Improve message for
	parenthesized range attribute usage
	(P_Expression_No_Right_Paren): Add missing comment about error recovery.

	* par-ch6.adb (P_Return_Object_Declaration): AI-318: Allow "constant"
	in the syntax for extended_return_statement. This is not in the latest
	RM, but the ARG is expected to issue an AI allowing this.
	(P_Return_Subtype_Indication,P_Return_Subtype_Indication): Remove
	N_Return_Object_Declaration. We now use N_Object_Declaration instead.
	(P_Return_Object_Declaration, P_Return_Subtype_Indication,
	P_Return_Statement): Parse the new syntax for extended_return_statement.

	* par-endh.adb (Check_End, Output_End_Deleted, Output_End_Expected,
	Output_End_Missing): Add error-recovery code for the new
	extended_return_statement syntax; that is, the new E_Return entry on
	the scope stack.

	* s-auxdec-vms_64.ads, s-auxdec.ads (AST_Handler): Change type from
	limited to nonlimited, because otherwise we violate the new Ada 2005
	rules about returning limited types in function Create_AST_Handler in
	s-asthan.adb.

	* sem.adb (Analyze): Add cases for new node kinds
	N_Extended_Return_Statement and N_Return_Object_Declaration.

	* sem_aggr.adb (Aggregate_Constraint_Checks): Verify that component
	type is in the same category as type of context before applying check,
	to prevent anomalies in instantiations.
	(Resolve_Aggregate): Remove test for limited components in aggregates.
	It's unnecessary in Ada 95, because if it has limited components, then
	it must be limited. It's wrong in Ada 2005, because limited aggregates
	are now allowed.
	(Resolve_Record_Aggregate): Move check for limited types later, because
	OK_For_Limited_Init requires its argument to have been resolved.
	(Get_Value): When copying the component default expression for a
	defaulted association in an aggregate, use the sloc of the aggregate
	and not that of the original expression, to prevent spurious
	elaboration errors, when the expression includes function calls.
	(Check_Non_Limited_Type): Correct code for AI-287, extension aggregates
	were missing. We also didn't handle qualified expressions. Now also
	allow function calls. Use new common routine OK_For_Limited_Init.
	(Resolve_Extension_Aggregate): Minor fix to bad error message (started
	with space can upper case letter).

        * sem_ch3.ads, sem_ch3.adb (Create_Constrained_Components): Set
	Has_Static_Discriminants flag
        (Record_Type_Declaration): Diagnose an attempt to declare an interface
        type with discriminants.
        (Process_Range_Expr_In_Decl): Do validity checks on range
	(Build_Discriminant_Constraints): Use updated form of
	Denotes_Discriminant.
	(Process_Subtype): If the subtype is a private subtype whose full view
	is a concurrent subtype, introduce an itype reference to prevent scope
	anomalies in gigi.
	(Build_Derived_Record_Type, Collect_Interface_Primitives,
	Record_Type_Declaration):  The functionality of the subprograms
	Collect_Abstract_Interfaces and Collect_All_Abstract_Interfaces
	is now performed by a single routine.
	(Build_Derived_Record_Type): If the type definition includes an explicit
	indication of limitedness, then the type must be marked as limited here
	to ensure that any access discriminants will not be treated as having
	a local anonymous access type.
	(Check_Abstract_Overriding): Issue a detailed error message when an
	abstract subprogram was not overridden due to incorrect mode of its
	first parameter.
	(Analyze_Private_Extension_Declaration): Add support for the analysis of
	synchronized private extension declarations. Verify that the ancestor is
	a limited or synchronized interface or in the generic case, the ancestor
	is a tagged limited type or synchronized interface and all progenitors
	are either limited or synchronized interfaces.
	Derived_Type_Declaration): Check for presence of private extension when
	dealing with synchronized formal derived types.
	Process_Full_View): Enchance the check done on the usage of "limited" by
	testing whether the private view is synchronized.
	Verify that a synchronized private view is completed by a protected or
	task type.
	(OK_For_Limited_Init_In_05): New function.
	(Analyze_Object_Declaration): Move check for limited types later,
	because OK_For_Limited_Init requires its argument to have been resolved.
	Add -gnatd.l --Use Ada 95 semantics for limited function returns,
	in order to alleviate the upward compatibility introduced by AI-318.
	(Constrain_Corresponding_Record): If the constraint is for a component
	subtype, mark the itype as frozen, to avoid out-of-scope references to
	discriminants in the back-end.
	(Collect_Implemented_Interfaces): Protect the recursive algorithm of
	this subprogram against wrong sources.
	(Get_Discr_Value, Is_Discriminant): Handle properly references to a
	discriminant of limited type completed with a protected type, when the
	discriminant is used to constrain a private component of the type, and
	expansion is disabled.
	(Find_Type_Of_Object): Do not treat a return subtype that is an
	anonymous subtype as a local_anonymous_type, because its accessibility
	level is the return type of the enclosing function.
	(Check_Initialization): In -gnatg mode, turn the error "cannot
	initialize entities of limited type" into a warning.
	(OK_For_Limited_Init): Return true for generated nodes, since it
	sometimes violates the legality rules.
	(Make_Incomplete_Declaration): If the type for which an incomplete
	declaration is created happens to be the currently visible entity,
	preserve the homonym chain when removing it from visibility.
	(Check_Conventions): Add support for Ada 2005 (AI-430): Conventions of
	inherited subprograms.
	(Access_Definition): If this is an access to function that is the return
	type of an access_to_function definition, context is a type declaration
	and the scope of the anonymous type is the current one.
	(Analyze_Subtype_Declaration): Add the defining identifier of a regular
	incomplete subtype to the set of private dependents of the original
	incomplete type.
	(Constrain_Discriminated_Type): Emit an error message whenever an
	incomplete subtype is being constrained.
	(Process_Incomplete_Dependents): Transform an incomplete subtype into a
	corresponding subtype of the full view of the original incomplete type.
	(Check_Incomplete): Properly detect invalid usage of incomplete types
	and subtypes.

From-SVN: r118273

1 files changed, 190 insertions, 11 deletions

diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb
index bcbda3d..d8f7fda 100644
--- a/gcc/ada/par-ch6.adb
+++ b/gcc/ada/par-ch6.adb
@@ -37,6 +37,12 @@ package body Ch6 is
 
    function P_Defining_Designator        return Node_Id;
    function P_Defining_Operator_Symbol   return Node_Id;
+   function P_Return_Object_Declaration  return Node_Id;
+
+   procedure P_Return_Subtype_Indication (Decl_Node : Node_Id);
+   --  Decl_Node is a N_Object_Declaration.
+   --  Set the Null_Exclusion_Present and Object_Definition fields of
+   --  Decl_Node.
 
    procedure Check_Junk_Semicolon_Before_Return;
 
@@ -1285,36 +1291,209 @@ package body Ch6 is
    -- 6.5  Return Statement --
    ---------------------------
 
+   --  SIMPLE_RETURN_STATEMENT ::= return [EXPRESSION];
+   --
+   --  EXTENDED_RETURN_STATEMENT ::=
+   --    return DEFINING_IDENTIFIER : [aliased] RETURN_SUBTYPE_INDICATION
+   --                                           [:= EXPRESSION] [do
+   --      HANDLED_SEQUENCE_OF_STATEMENTS
+   --    end return];
+   --
+   --  RETURN_SUBTYPE_INDICATION ::= SUBTYPE_INDICATION | ACCESS_DEFINITION
+
    --  RETURN_STATEMENT ::= return [EXPRESSION];
 
-   --  The caller has checked that the initial token is RETURN
+   --  Error recovery: can raise Error_Resync
+
+   procedure P_Return_Subtype_Indication (Decl_Node : Node_Id) is
+
+      --  Note: We don't need to check Ada_Version here, because this is
+      --  only called in >= Ada 2005 cases anyway.
+
+      Not_Null_Present : constant Boolean := P_Null_Exclusion;
+
+   begin
+      Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
+
+      if Token = Tok_Access then
+         Set_Object_Definition
+           (Decl_Node, P_Access_Definition (Not_Null_Present));
+      else
+         Set_Object_Definition
+           (Decl_Node, P_Subtype_Indication (Not_Null_Present));
+      end if;
+   end P_Return_Subtype_Indication;
+
+   --  Error recovery: can raise Error_Resync
+
+   function P_Return_Object_Declaration return Node_Id is
+      Return_Obj : Node_Id;
+      Decl_Node  : Node_Id;
+
+   begin
+      Return_Obj := Token_Node;
+      Change_Identifier_To_Defining_Identifier (Return_Obj);
+      Decl_Node := New_Node (N_Object_Declaration, Token_Ptr);
+      Set_Defining_Identifier (Decl_Node, Return_Obj);
+
+      Scan; -- past identifier
+      Scan; -- past :
+
+      --  First an error check, if we have two identifiers in a row, a likely
+      --  possibility is that the first of the identifiers is an incorrectly
+      --  spelled keyword. See similar check in P_Identifier_Declarations.
+
+      if Token = Tok_Identifier then
+         declare
+            SS : Saved_Scan_State;
+            I2 : Boolean;
+
+         begin
+            Save_Scan_State (SS);
+            Scan; -- past initial identifier
+            I2 := (Token = Tok_Identifier);
+            Restore_Scan_State (SS);
+
+            if I2
+              and then
+                (Bad_Spelling_Of (Tok_Access)   or else
+                 Bad_Spelling_Of (Tok_Aliased)  or else
+                 Bad_Spelling_Of (Tok_Constant))
+            then
+               null;
+            end if;
+         end;
+      end if;
+
+      --  We allow "constant" here (as in "return Result : constant
+      --  T..."). This is not in the latest RM, but the ARG is considering an
+      --  AI on the subject (see AI05-0015-1), which we expect to be approved.
+
+      if Token = Tok_Constant then
+         Scan; -- past CONSTANT
+         Set_Constant_Present (Decl_Node);
+
+         if Token = Tok_Aliased then
+            Error_Msg_SC ("ALIASED should be before CONSTANT");
+            Scan; -- past ALIASED
+            Set_Aliased_Present (Decl_Node);
+         end if;
+
+      elsif Token = Tok_Aliased then
+         Scan; -- past ALIASED
+         Set_Aliased_Present (Decl_Node);
+
+         if Token = Tok_Constant then
+            Scan; -- past CONSTANT
+            Set_Constant_Present (Decl_Node);
+         end if;
+      end if;
+
+      P_Return_Subtype_Indication (Decl_Node);
+
+      if Token = Tok_Colon_Equal then
+         Scan; -- past :=
+         Set_Expression (Decl_Node, P_Expression_No_Right_Paren);
+      end if;
+
+      return Decl_Node;
+   end P_Return_Object_Declaration;
 
    --  Error recovery: can raise Error_Resync
 
    function P_Return_Statement return Node_Id is
+      --  The caller has checked that the initial token is RETURN
+
+      function Is_Simple return Boolean;
+      --  Scan state is just after RETURN (and is left that way).
+      --  Determine whether this is a simple or extended return statement
+      --  by looking ahead for "identifier :", which implies extended.
+
+      ---------------
+      -- Is_Simple --
+      ---------------
+
+      function Is_Simple return Boolean is
+         Scan_State : Saved_Scan_State;
+         Result     : Boolean := True;
+
+      begin
+         if Token = Tok_Identifier then
+            Save_Scan_State (Scan_State); -- at identifier
+            Scan; -- past identifier
+
+            if Token = Tok_Colon then
+               Result := False; -- It's an extended_return_statement.
+            end if;
+
+            Restore_Scan_State (Scan_State); -- to identifier
+         end if;
+
+         return Result;
+      end Is_Simple;
+
+      Return_Sloc : constant Source_Ptr := Token_Ptr;
       Return_Node : Node_Id;
 
+   --  Start of processing for P_Return_Statement
+
    begin
-      Return_Node := New_Node (N_Return_Statement, Token_Ptr);
+      Scan; -- past RETURN
 
-      --  Sloc points to RETURN
-      --  Expression (Op3)
+      --  Simple_return_statement, no expression, return an N_Return_Statement
+      --  node with the expression field left Empty.
 
-      Scan; -- past RETURN
+      if Token = Tok_Semicolon then
+         Scan; -- past ;
+         Return_Node := New_Node (N_Return_Statement, Return_Sloc);
 
-      if Token /= Tok_Semicolon then
+      --  Non-simple case
 
-         --  If no semicolon, then scan an expression, except that
-         --  we avoid trying to scan an expression if we are at an
+      else
+         --  Simple_return_statement with expression
+
+         --  We avoid trying to scan an expression if we are at an
          --  expression terminator since in that case the best error
          --  message is probably that we have a missing semicolon.
 
-         if Token not in Token_Class_Eterm then
-            Set_Expression (Return_Node, P_Expression_No_Right_Paren);
+         if Is_Simple then
+            Return_Node := New_Node (N_Return_Statement, Return_Sloc);
+
+            if Token not in Token_Class_Eterm then
+               Set_Expression (Return_Node, P_Expression_No_Right_Paren);
+            end if;
+
+         --  Extended_return_statement (Ada 2005 only -- AI-318):
+
+         else
+            if Ada_Version < Ada_05 then
+               Error_Msg_SP
+                 (" extended_return_statement is an Ada 2005 extension");
+               Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
+            end if;
+
+            Return_Node := New_Node (N_Extended_Return_Statement, Return_Sloc);
+            Set_Return_Object_Declarations
+              (Return_Node, New_List (P_Return_Object_Declaration));
+
+            if Token = Tok_Do then
+               Push_Scope_Stack;
+               Scope.Table (Scope.Last).Etyp := E_Return;
+               Scope.Table (Scope.Last).Ecol := Start_Column;
+               Scope.Table (Scope.Last).Sloc := Return_Sloc;
+
+               Scan; -- past DO
+               Set_Handled_Statement_Sequence
+                 (Return_Node, P_Handled_Sequence_Of_Statements);
+               End_Statements;
+
+               --  Do we need to handle Error_Resync here???
+            end if;
          end if;
+
+         TF_Semicolon;
       end if;
 
-      TF_Semicolon;
       return Return_Node;
    end P_Return_Statement;