par-ch3.adb: (P_Type_Declaration): Set Type_Token_Location

2007-04-06  Robert Dewar  <dewar@adacore.com>
	    Javier Miranda  <miranda@adacore.com>
	    Bob Duff  <duff@adacore.com>

	* par-ch3.adb: (P_Type_Declaration): Set Type_Token_Location
	(P_Interface_Type_Definition): Remove the formal Is_Synchronized because
	there is no need to generate always a record_definition_node in case
	of synchronized interface types.
	(P_Type_Declaration): Update calls to P_Interface_Type_Definition.
	(P_Null_Exclusion): For AI-447: Remove warnings about "not null" being
	illegal in Ada 95, in cases where it is legal. Change the warnings to
	errors in other cases. Don't give the error unless the "not null"
	parses properly. Correct the source position at which the error occurs.
	(P_Known_Discriminant_Part_Opt): Pass Allow_Anonymous_In_95 => True to
	P_Null_Exclusion, to suppress "not null" warnings.
	(P_Identifier_Declarations): Code cleanup. Removed unrequired label and
	associated goto statements.

	* par-endh.adb (Pop_End_Context): Allow more flexibility in placement
	of END RECORD

	* scans.ads (Type_Token_Location): New flag

	* par-ch6.adb (P_Mode): Check specifically for case of IN ACCESS
	(P_Formal_Part): Pass Allow_Anonymous_In_95 => True to
	P_Null_Exclusion, to suppress "not null" warnings.

From-SVN: r123587

4 files changed, 91 insertions, 60 deletions

diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb
index 8e8ac2a..b284b30 100644
--- a/gcc/ada/par-ch3.adb
+++ b/gcc/ada/par-ch3.adb
@@ -286,6 +286,7 @@ package body Ch3 is
       --  If we have TYPE, then proceed ahead and scan identifier
 
       if Token = Tok_Type then
+         Type_Token_Location := Type_Loc;
          Scan; -- past TYPE
          Ident_Node := P_Defining_Identifier (C_Is);
 
@@ -634,9 +635,8 @@ package body Ch3 is
                  or else (Token = Tok_Identifier
                            and then Chars (Token_Node) = Name_Interface)
                then
-                  Typedef_Node := P_Interface_Type_Definition
-                                    (Abstract_Present,
-                                     Is_Synchronized => False);
+                  Typedef_Node :=
+                    P_Interface_Type_Definition (Abstract_Present);
                   Abstract_Present := True;
                   Set_Limited_Present (Typedef_Node);
 
@@ -721,8 +721,7 @@ package body Ch3 is
             --  Ada 2005 (AI-251): INTERFACE
 
             when Tok_Interface =>
-               Typedef_Node := P_Interface_Type_Definition
-                                (Abstract_Present, Is_Synchronized => False);
+               Typedef_Node := P_Interface_Type_Definition (Abstract_Present);
                Abstract_Present := True;
                TF_Semicolon;
                exit;
@@ -761,8 +760,7 @@ package body Ch3 is
 
                   else
                      Typedef_Node :=
-                       P_Interface_Type_Definition
-                         (Abstract_Present, Is_Synchronized => True);
+                       P_Interface_Type_Definition (Abstract_Present);
                      Abstract_Present := True;
 
                      case Saved_Token is
@@ -925,25 +923,44 @@ package body Ch3 is
 
    --  Error recovery: can raise Error_Resync
 
-   function P_Null_Exclusion return Boolean is
+   function P_Null_Exclusion
+     (Allow_Anonymous_In_95 : Boolean := False) return Boolean
+   is
+      Not_Loc : constant Source_Ptr := Token_Ptr;
+      --  Source position of "not", if present
+
    begin
       if Token /= Tok_Not then
          return False;
 
       else
-         --  Ada 2005 (AI-441): The qualifier has no semantic meaning in Ada 95
-         --  (all access Parameters Are "not null" in Ada 95).
-
-         if Ada_Version < Ada_05 then
-            Error_Msg_SP
-              ("null-excluding access is an Ada 2005 extension?");
-            Error_Msg_SP ("\unit should be compiled with -gnat05 switch?");
-         end if;
-
          Scan; --  past NOT
 
          if Token = Tok_Null then
             Scan; --  past NULL
+
+            --  Ada 2005 (AI-441, AI-447): null_exclusion is illegal in Ada 95,
+            --  except in the case of anonymous access types.
+            --  Allow_Anonymous_In_95 will be True if we're parsing a
+            --  formal parameter or discriminant, which are the only places
+            --  where anonymous access types occur in Ada 95. "Formal : not
+            --  null access ..." is legal in Ada 95, whereas "Formal : not
+            --  null Named_Access_Type" is not.
+
+            if Ada_Version >= Ada_05
+              or else (Ada_Version >= Ada_95
+                        and then Allow_Anonymous_In_95
+                        and then Token = Tok_Access)
+            then
+               null; -- OK
+
+            else
+               Error_Msg
+                 ("null-excluding access is an Ada 2005 extension", Not_Loc);
+               Error_Msg
+                 ("\unit should be compiled with -gnat05 switch", Not_Loc);
+            end if;
+
          else
             Error_Msg_SP ("NULL expected");
          end if;
@@ -953,8 +970,9 @@ package body Ch3 is
    end P_Null_Exclusion;
 
    function P_Subtype_Indication
-     (Not_Null_Present : Boolean := False) return Node_Id is
-      Type_Node        : Node_Id;
+     (Not_Null_Present : Boolean := False) return Node_Id
+   is
+      Type_Node : Node_Id;
 
    begin
       if Token = Tok_Identifier or else Token = Tok_Operator_Symbol then
@@ -984,9 +1002,10 @@ package body Ch3 is
 
    function P_Subtype_Indication
      (Subtype_Mark     : Node_Id;
-      Not_Null_Present : Boolean := False) return Node_Id is
-      Indic_Node       : Node_Id;
-      Constr_Node      : Node_Id;
+      Not_Null_Present : Boolean := False) return Node_Id
+   is
+      Indic_Node  : Node_Id;
+      Constr_Node : Node_Id;
 
    begin
       Constr_Node := P_Constraint_Opt;
@@ -1019,7 +1038,6 @@ package body Ch3 is
    function P_Subtype_Mark return Node_Id is
    begin
       return P_Subtype_Mark_Resync;
-
    exception
       when Error_Resync =>
          return Error;
@@ -1602,7 +1620,6 @@ package body Ch3 is
                if Token /= Tok_Renames then
                   Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
                   Set_Object_Definition (Decl_Node, Acc_Node);
-                  goto init;
 
                else
                   Scan; --  past renames
@@ -1675,7 +1692,6 @@ package body Ch3 is
             if Token /= Tok_Renames then
                Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
                Set_Object_Definition (Decl_Node, Acc_Node);
-               goto init; -- ??? is this really needed goes here anyway
 
             else
                Scan; --  past renames
@@ -1723,7 +1739,6 @@ package body Ch3 is
 
          --  Scan out initialization, allowed only for object declaration
 
-         <<init>> -- is this really needed ???
          Init_Loc := Token_Ptr;
          Init_Expr := Init_Expr_Opt;
 
@@ -2785,7 +2800,8 @@ package body Ch3 is
                Specification_Node :=
                  New_Node (N_Discriminant_Specification, Ident_Sloc);
                Set_Defining_Identifier (Specification_Node, Idents (Ident));
-               Not_Null_Present := P_Null_Exclusion; -- Ada 2005 (AI-231)
+               Not_Null_Present :=  --  Ada 2005 (AI-231, AI-447)
+                 P_Null_Exclusion (Allow_Anonymous_In_95 => True);
 
                if Token = Tok_Access then
                   if Ada_Version = Ada_83 then
@@ -3566,8 +3582,7 @@ package body Ch3 is
    --  Error recovery: cannot raise Error_Resync
 
    function P_Interface_Type_Definition
-     (Abstract_Present : Boolean;
-      Is_Synchronized  : Boolean) return Node_Id
+     (Abstract_Present : Boolean) return Node_Id
    is
       Typedef_Node : Node_Id;
 
@@ -3584,13 +3599,10 @@ package body Ch3 is
 
       Scan; -- past INTERFACE
 
-      --  Ada 2005 (AI-345): In case of synchronized interfaces and
-      --  interfaces with a null list of interfaces we build a
-      --  record_definition node.
+      --  Ada 2005 (AI-345): In case of interfaces with a null list of
+      --  interfaces we build a record_definition node.
 
-      if Is_Synchronized
-        or else Token = Tok_Semicolon
-      then
+      if Token = Tok_Semicolon then
          Typedef_Node := New_Node (N_Record_Definition, Token_Ptr);
 
          Set_Abstract_Present  (Typedef_Node);
@@ -3598,20 +3610,6 @@ package body Ch3 is
          Set_Null_Present      (Typedef_Node);
          Set_Interface_Present (Typedef_Node);
 
-         if Is_Synchronized
-           and then Token = Tok_And
-         then
-            Scan; -- past AND
-            Set_Interface_List (Typedef_Node, New_List);
-
-            loop
-               Append (P_Qualified_Simple_Name,
-                       Interface_List (Typedef_Node));
-               exit when Token /= Tok_And;
-               Scan; -- past AND
-            end loop;
-         end if;
-
       --  Ada 2005 (AI-251): In case of not-synchronized interfaces that have
       --  a list of interfaces we build a derived_type_definition node. This
       --  simplifies the semantic analysis (and hence further mainteinance)
@@ -3678,18 +3676,23 @@ package body Ch3 is
    --  Error recovery: can raise Error_Resync
 
    function P_Access_Type_Definition
-     (Header_Already_Parsed : Boolean := False) return Node_Id is
-      Access_Loc            : constant Source_Ptr := Token_Ptr;
-      Prot_Flag             : Boolean;
-      Not_Null_Present      : Boolean := False;
-      Type_Def_Node         : Node_Id;
-      Result_Not_Null       : Boolean;
-      Result_Node           : Node_Id;
+     (Header_Already_Parsed : Boolean := False) return Node_Id
+   is
+      Access_Loc       : constant Source_Ptr := Token_Ptr;
+      Prot_Flag        : Boolean;
+      Not_Null_Present : Boolean := False;
+      Type_Def_Node    : Node_Id;
+      Result_Not_Null  : Boolean;
+      Result_Node      : Node_Id;
 
       procedure Check_Junk_Subprogram_Name;
       --  Used in access to subprogram definition cases to check for an
       --  identifier or operator symbol that does not belong.
 
+      --------------------------------
+      -- Check_Junk_Subprogram_Name --
+      --------------------------------
+
       procedure Check_Junk_Subprogram_Name is
          Saved_State : Saved_Scan_State;
 
@@ -3846,7 +3849,8 @@ package body Ch3 is
    --  Error recovery: cannot raise Error_Resync
 
    function P_Access_Definition
-     (Null_Exclusion_Present : Boolean) return Node_Id is
+     (Null_Exclusion_Present : Boolean) return Node_Id
+   is
       Def_Node  : Node_Id;
       Subp_Node : Node_Id;
 
diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb
index d8f7fda..903cc4e 100644
--- a/gcc/ada/par-ch6.adb
+++ b/gcc/ada/par-ch6.adb
@@ -1084,7 +1084,13 @@ package body Ch6 is
                Specification_Node :=
                  New_Node (N_Parameter_Specification, Ident_Sloc);
                Set_Defining_Identifier (Specification_Node, Idents (Ident));
-               Not_Null_Present := P_Null_Exclusion;     --  Ada 2005 (AI-231)
+
+               --  Scan possible NOT NULL for Ada 2005 (AI-231, AI-447)
+
+               Not_Null_Present :=
+                 P_Null_Exclusion (Allow_Anonymous_In_95 => True);
+
+               --  Case of ACCESS keyword present
 
                if Token = Tok_Access then
                   Set_Null_Exclusion_Present
@@ -1094,8 +1100,11 @@ package body Ch6 is
                      Error_Msg_SC ("(Ada 83) access parameters not allowed");
                   end if;
 
-                  Set_Parameter_Type (Specification_Node,
-                    P_Access_Definition (Not_Null_Present));
+                  Set_Parameter_Type
+                    (Specification_Node,
+                     P_Access_Definition (Not_Null_Present));
+
+               --  Case of IN or OUT present
 
                else
                   if Token = Tok_In or else Token = Tok_Out then
@@ -1237,6 +1246,11 @@ package body Ch6 is
          if Style.Mode_In_Check and then Token /= Tok_Out then
             Error_Msg_SP ("(style) IN should be omitted");
          end if;
+
+         if Token = Tok_Access then
+            Error_Msg_SP ("IN not allowed together with ACCESS");
+            Scan; -- past ACCESS
+         end if;
       end if;
 
       if Token = Tok_Out then
diff --git a/gcc/ada/par-endh.adb b/gcc/ada/par-endh.adb
index a6d5297..92f7e9b 100644
--- a/gcc/ada/par-endh.adb
+++ b/gcc/ada/par-endh.adb
@@ -1042,6 +1042,13 @@ package body Endh is
             if Style.RM_Column_Check then
                if End_Column /= Scope.Table (Scope.Last).Ecol
                  and then Current_Line_Start > Scope.Table (Scope.Last).Sloc
+
+               --  A special case, for END RECORD, we are also allowed to
+               --  line up with the TYPE keyword opening the declaration.
+
+                 and then (Scope.Table (Scope.Last).Etyp /= E_Record
+                            or else Get_Column_Number (End_Sloc) /=
+                                    Get_Column_Number (Type_Token_Location))
                then
                   Error_Msg_Col := Scope.Table (Scope.Last).Ecol;
                   Error_Msg
diff --git a/gcc/ada/scans.ads b/gcc/ada/scans.ads
index 694a603..a01b957 100644
--- a/gcc/ada/scans.ads
+++ b/gcc/ada/scans.ads
@@ -365,6 +365,12 @@ package Scans is
    --  on the line containing the current token. This is used for error
    --  recovery circuits which depend on looking at the column line up.
 
+   Type_Token_Location : Source_Ptr;
+   --  Within a type declaration, gives the location of the TYPE keyword that
+   --  opened the type declaration. Used in checking the end column of a record
+   --  declaration, which can line up either with the TYPE keyword, or with the
+   --  start of the line containing the RECORD keyword.
+
    Checksum : Word;
    --  Used to accumulate a CRC representing the tokens in the source
    --  file being compiled. This CRC includes only program tokens, and