2004-04-19 Arnaud Charlet <charlet@act-europe.fr>

	* 5isystem.ads: Removed, unused.

	* gnat_rm.texi: Redo 1.13 change.

2004-04-19  Robert Dewar  <dewar@gnat.com>

	* s-stoele.ads: Clean up definition of Storage_Offset (the new
	definition is cleaner, avoids the kludge of explicit Standard operator
	references, and also is consistent with a visible System.Address with
	no visible operations.

	* s-geveop.adb: Add declarations to avoid assumption of visible
	operations on type System.Address (since these might not be available
	if Address is a non-private type for which the operations
	are made abstract).

	* sem_eval.adb: Minor reformatting

	* s-carsi8.ads, s-carun8.ads, s-casi16.ads, s-casi32.ads,
	s-casi64.ads, s-caun16.ads, s-caun32.ads, s-caun64.ads: Minor
	reformatting (new function spec format).

	* s-auxdec.adb, s-carsi8.adb, s-carun8.adb, s-casi16.adb,
	s-casi32.adb, s-casi64.adb, s-caun16.adb, s-caun32.adb,
	s-caun64.adb: Add declarations to avoid assumption of visible
	operations on type System.Address (since these might not be available
	if Address is a non-private type for which the operations are made
	abstract).

	* lib.ads, lib.adb (Synchronize_Serial_Number): New procedure.

	* exp_intr.adb: Minor comment update

	* exp_aggr.adb, exp_attr.adb, exp_ch13.adb: Minor reformatting.

	* 5omastop.adb: Add declarations to avoid assumption of visible
	operations on type System.Address (since these might not be available
	if Address is a non-private type for which the operations
	are made abstract).

2004-04-19  Vincent Celier  <celier@gnat.com>

	* switch-m.adb: (Scan_Make_Switches): Process new switch -eL

	* prj-pars.ads (Parse): New Boolean parameter Process_Languages,
	defaulted to Ada.

	* prj-proc.adb (Process): New Boolean parameter Process_Languages,
	defaulted to Ada.
	Call Check with Process_Languages.
	(Check): New Boolean parameter Process_Languages. Call Recursive_Check
	with Process_Languages.
	(Recursive_Check): New Boolean parameter Process_Languages. Call
	Nmsc.Ada_Check or Nmsc.Other_Languages_Check according to
	Process_Languages.

	* prj-proc.ads (Process): New Boolean parameter Process_Languages,

	* prj-util.ads, prj-util.adb (Executable_Of): New Boolean
	parameter Ada_Main, defaulted to True.
	Check for Ada specific characteristics only when Ada_Main is True.

	* opt.ads: (Follow_Links): New Boolean flag for gnatmake

	* prj.adb: (Project_Empty): Add new Project_Data components.

	* prj.ads: New types and tables for non Ada languages.
	(Project_Data): New components Languages, Impl_Suffixes,
	First_Other_Source, Last_Other_Source, Imported_Directories_Switches,
	Include_Path, Include_Data_Set.

	* prj-env.ads, prj-env.adb: Minor reformatting

	* prj-nmsc.ads, prj-nmsc.adb: (Other_Languages_Check): New procedure
	Put subprograms in alphabetical order

	* prj-pars.adb (Parse): New Boolean parameter Process_Languages,
	defaulted to Ada; Call Prj.Proc.Process with Process_Languages and
	Opt.Follow_Links.

	* mlib-prj.adb: Back out modification in last version, as they are
	incorrect.
	(Build_Library.Check_Libs): Remove useless pragma Warnings (Off)

	* make.adb: (Mains): Moved to package Makeutl
	(Linker_Opts): Moved to package Makeutl
	(Is_External_Assignment): Moved to package Makeutl
	(Test_If_Relative_Path): Moved to package Makeutl
	(Gnatmake): Move sorting of linker options to function
	Makeutl.Linker_Options_Switches.

	* Makefile.in: Add makeutl.o to the object files for gnatmake

	* makeusg.adb: Add line for new switch -eL.

	* gnatls.adb (Image): New function.
	(Output_Unit): If in verbose mode, output the list of restrictions
	specified by pragmas Restrictions.

	* 5bml-tgt.adb, 5vml-tgt.adb (Build_Dynamic_Library): Do not use
	Text_IO.

	* a-calend.adb (Split): Shift the date by multiple of 56 years, if
	needed, to put it in the range 1970 (included) - 2026 (excluded).
	(Time_Of): Do not shift Unix_Min_Year (1970).
	Shift the date by multiple of 56 years, if needed, to put it in the
	range 1970 (included) - 2026 (excluded).

	* adaint.h, adaint.c (__gnat_set_executable): New function.

2004-04-19  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	* trans.c (tree_transform, case N_Subprogram_Body): Temporarily push
	and pop GC context.
	(tree_transform, case N_Procedure_Call): Fix typo in setting TREE_TYPE.
	(tree_transform, case N_Label): Don't set LABEL_STMT_FIRST_IN_EH.
	(tree_transform, case N_Procedure_Call_Statement): Build a tree.
	(tree_transform, case N_Code_Statement): Likewise.
	(gnat_expand_stmt, case LABEL_STMT): Don't look at
	LABEL_STMT_FIRST_IN_EH.
	(gnat_expand_stmt, case ASM_STMT): New case.

	* utils2.c (build_unary_op): Properly set TREE_READONLY of
	UNCONSTRAINED_ARRAY_REF.

	* utils.c (poplevel): Temporarily push/pop GC context around inline
	function expansion.

	* decl.c (maybe_variable): Properly set TREE_READONLY of
	UNCONSTRAINED_ARRAY_REF.
	(make_packable_type): Only reference TYPE_IS_PADDING_P for RECORD_TYPE.

	* ada-tree.def: (ASM_STMT): New.

	* ada-tree.h: (LABEL_STMT_FIRST_IN_EH): Deleted.
	(ASM_STMT_TEMPLATE, ASM_STMT_OUTPUT, ASM_STMT_ORIG_OUT,
	ASM_STMT_INPUT): New.
	(ASM_STMT_CLOBBER): Likewise.

2004-04-19  Thomas Quinot  <quinot@act-europe.fr>

	* a-except.adb, s-parint.ads, s-parint.adb, types.ads, types.h: Use
	general rcheck mechanism to raise Program_Error for E.4(18), instead
	of a custom raiser in System.Partition_Interface.
	Part of general cleanup work before PolyORB integration.

	* snames.ads, snames.adb: Add new runtime library entities and names
	for PolyORB DSA.

	* sem_dist.ads, sem_dist.adb (Get_Subprogram_Id): Move from sem_dist to
	exp_dist.
	(Build_Subprogram_Id): New subprogram provided by exp_dist
	Code reorganisation in preparation for PolyORB integration.

	* exp_dist.ads, exp_dist.adb (Get_Subprogram_Id): Move from sem_dist to
	exp_dist.
	(Build_Subprogram_Id): New subprogram provided by exp_dist

	* sem_ch4.adb (Analyze_One_Call): Fix error message for mismatch in
	actual parameter types for call to dereference of an
	access-to-subprogram type.

	* rtsfind.ads: Add new runtime library entities and names for PolyORB
	DSA.

	* gnatlink.adb (Value): Remove. Use Interfaces.C.Strings.Value
	instead, which has the same behaviour here since we never pass it a
	NULL pointer.

	* link.c (run_path_option, Solaris case): Use -Wl, as for other
	platforms.

	* Makefile.in: adjust object file lists for gnatlink and gnatmake
	to account for new dependency upon Interfaces.C.Strings + link.o
	For x86 FreeBSD, use 86numaux.

	* make.adb, gnatcmd.adb: Linker_Library_Path_Option has been moved up
	from Mlib.Tgt to Mlib.

	* mlib.ads, mlib.adb (Linker_Library_Path_Option): New subprogram, now
	target-independent.

	* mlib-tgt.ads, mlib-tgt.adb (Linker_Library_Path_Option): Remove
	target-specific versions of this subprogram, now implemented as a
	target-independent function in Mlib.

	* 5aml-tgt.adb, 5bml-tgt.adb, 5gml-tgt.adb, 5hml-tgt.adb, 5lml-tgt.adb,
	5sml-tgt.adb, 5vml-tgt.adb, 5zml-tgt.adb, 5wml-tgt.adb
	(Linker_Library_Path_Option): Remove target-specific versions of this
	subprogram, now implemented as a target-independent function in Mlib.

	* atree.adb: (Allocate_Initialize_Node): New subprogram.
	Factors out node table slots allocation.
	(Fix_Parents): New subprogram.
	Encapsulate the pattern of fixing up parent pointers for syntactic
	children of a rewritten node.
	(New_Copy_Tree): Use New_Copy to copy non-entity nodes.
	(Rewrite): Use New_Copy when creating saved copy of original node.
	(Replace): Use Copy_Node to copy nodes.

2004-04-19  Javier Miranda  <miranda@gnat.com>

	* sprint.adb (Sprint_Node_Actual): Give support to the new
	Access_To_Subprogram node available in Access_Definition nodes. In
	addition, give support to the AI-231 node fields: null-exclusion,
	all-present, constant-present.

	* sem_util.ads, sem_util.adb: (Has_Declarations): New subprogram

	* sinfo.ads, sinfo.adb:
	New field Access_To_Subprogram_Definition in Access_Definition nodes

	* sem_ch6.adb (Process_Formals): Move here the code that creates and
	decorates internal subtype declaration corresponding to the
	null-excluding formal. This code was previously in Set_Actual_Subtypes.
	In addition, carry out some code cleanup on this code. In case of
	access to protected subprogram call
	Replace_Anonymous_Access_To_Protected_Subprogram.
	(Set_Actual_Subtypes): Code cleanup.

	* sem_ch8.adb (Analyze_Object_Renaming): Remove un-necessary call to
	Find_Type in case of anonymous access renamings. Add warning in case of
	null-excluding attribute used in anonymous access renaming.

	* sem_ch3.ads (Replace_Anonymous_Access_To_Protected_Subprogram): New
	subprogram

	* sem_ch3.adb (Replace_Anonymous_Access_To_Protected_Subprogram): New
	subprogram.
	(Access_Definition): In case of anonymous access to subprograms call
	the corresponding semantic routine to decorate the node.
	(Access_Subprogram_Declaration): Addition of some comments indicating
	some code that probably should be added here. Detected by comparison
	with the access_definition subprogram.
	(Analyze_Component_Declaration): In case of access to protected
	subprogram call Replace_Anonymous_Access_To_Protected.
	(Array_Type_Declaration): In case of access to protected subprogram call
	Replace_Anonymous_Access_To_Protected_Subprogram.
	(Process_Discriminants): In case of access to protected subprogram call
	Replace_Anonymous_Access_To_Protected_Subprogram.

	* par.adb (P_Access_Definition): New formal that indicates if the
	null-exclusion part was present.
	(P_Access_Type_Definition): New formal that indicates if the caller has
	already parsed the null-excluding part.

	* par-ch3.adb (P_Subtype_Declaration): Code cleanup.
	(P_Identifier_Declarations): Code cleanup and give support to renamings
	of anonymous access to subprogram types.
	(P_Derived_Type_Def_Or_Private_Ext_Decl): Code cleanup.
	(P_Array_Type_Definition): Give support to AI-254.
	(P_Component_Items): Give support to AI-254.
	(P_Access_Definition): New formal that indicates if the header was
	already parsed by the caller.
	(P_Access_Type_Definition): New formal that indicates if the caller has
	already parsed the null-excluding part.

	* par-ch6.adb (P_Formal_Part): Add the null-excluding parameter to the
	call to P_Access_Definition.

2004-04-19  Geert Bosch  <bosch@gnat.com>

	* checks.adb (Apply_Float_Conversion_Check): New procedure to implement
	the delicate semantics of floating-point to integer conversion.
	(Apply_Type_Conversion_Checks): Use Apply_Float_Conversion_Check.

	* eval_fat.adb (Machine_Mantissa): Moved to spec.
	(Machine_Radix): New function.

	* eval_fat.ads (Machine_Mantissa): Moved from body for use in
	conversion checks.
	(Machine_Radix): New function also for use in conversion checks.

2004-04-19  Ed Schonberg  <schonberg@gnat.com>

	* par-prag.adb (Source_File_Name_Project): Fix typo in error message.

	* exp_ch9.adb (Expand_Access_Protected_Subprogram_Type): Call analyze
	to decorate the access-to-protected subprogram and the equivalent type.

	* checks.adb (Null_Exclusion_Static_Checks): Code cleanup. Give support
	to anonymous access to subprogram types.

	* exp_ch4.adb (Expand_N_In): Preserve Static flag before
	constant-folding, for legality checks in contexts that require an RM
	static expression.

	* exp_ch6.adb (Expand_N_Function_Call): If call may generate large
	temporary but stack checking is not enabled, increment serial number
	to so that symbol generation is consistent with and without stack
	checking.

	* exp_util.ads, exp_util.adb (May_Generate_Large_Temp): Predicate is
	independent on whether stack checking is enabled, caller must check
	the corresponding flag.

	* sem_ch3.adb (Constrain_Index): Index bounds given by attributes need
	range checks.
	(Build_Derived_Concurrent_Type): Inherit Is_Constrained flag from
	parent if it has discriminants.
	(Build_Derived_Private_Type): Constructed full view does
	not come from source.
	(Process_Discriminants): Default discriminants on a tagged type are
	legal if this is the internal completion of a private untagged
	derivation.

	* sem_ch6.adb (Set_Actual_Subtypes): The generated declaration needs
	no constraint checks, because it corresponds to an existing object.

	* sem_prag.adb (Process_Convention): Pragma applies
	only to subprograms in the same declarative part, i.e. the same unit,
	not the same scope.

	* sem_res.adb (Valid_Conversion): In an instance or inlined body,
	ignore type mismatch on a numeric conversion if expression comes from
	expansion.

2004-04-19  Sergey Rybin  <rybin@act-europe.fr>

	* sem_elim.adb (Process_Eliminate_Pragma): Remove the processing for
	Homonym_Number parameter, add processing for Source_Location parameter
	corresponding.
	(Check_Eliminated): Remove the check for homonym numbers, add the check
	for source location traces.

	* sem_elim.ads (Process_Eliminate_Pragma): Replace Arg_Homonym_Number
	with Arg_Source_Location corresponding to the changes in the format of
	the pragma.

	* sem_prag.adb: (Analyze_Pragma): Changes in the processing of
	Eliminate pragma corresponding to the changes in the format of the
	pragma: Homonym_Number is replaced with Source_Location, two ways of
	distinguishing homonyms are mutially-exclusive.

2004-04-19  Joel Brobecker  <brobecker@gnat.com>

	* get_targ.ads (Get_No_Dollar_In_Label): Remove.

	* exp_dbug.adb (Output_Homonym_Numbers_Suffix): Remove use of
	No_Dollar_In_Label, no longer necessary, as it is always True.
	(Strip_Suffixes): Likewise.

2004-04-19  Gary Dismukes  <dismukes@gnat.com>

	* s-stalib.ads (type Exception_Code): Use Integer'Size for exponent of
	modulus for compatibility with size clause on targets with 16-bit
	Integer.

	* layout.adb (Discrimify): In the case of private types, set Vtyp to
	full type to fix type mismatches on calls to size functions for
	discriminant-dependent array components.

2004-04-19  Jerome Guitton  <guitton@act-europe.fr>

	* Makefile.in (gnatlib-zcx): New target, for building a ZCX run-time
	lib.

2004-04-19  Pascal Obry  <obry@gnat.com>

	* mdll-utl.adb (Locate): New version is idempotent.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@80856 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 193 insertions, 94 deletions

diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb
index c109d3f2387..dad0101e46a 100644
--- a/gcc/ada/par-ch3.adb
+++ b/gcc/ada/par-ch3.adb
@@ -741,10 +741,8 @@ package body Ch3 is
          Scan; -- past NEW
       end if;
 
-      if Extensions_Allowed then                      --  Ada 0Y (AI-231)
-         Not_Null_Present := P_Null_Exclusion;
-         Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
-      end if;
+      Not_Null_Present := P_Null_Exclusion; --  Ada 0Y (AI-231)
+      Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
 
       Set_Subtype_Indication
         (Decl_Node, P_Subtype_Indication (Not_Null_Present));
@@ -1293,7 +1291,6 @@ package body Ch3 is
 
             else
                Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
-               Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
                Set_Constant_Present (Decl_Node, True);
 
                if Token_Name = Name_Aliased then
@@ -1312,10 +1309,8 @@ package body Ch3 is
                     (Decl_Node, P_Array_Type_Definition);
 
                else
-                  if Extensions_Allowed then              --  Ada 0Y (AI-231)
-                     Not_Null_Present := P_Null_Exclusion;
-                     Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
-                  end if;
+                  Not_Null_Present := P_Null_Exclusion; --  Ada 0Y (AI-231)
+                  Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
 
                   Set_Object_Definition (Decl_Node,
                      P_Subtype_Indication (Not_Null_Present));
@@ -1351,7 +1346,6 @@ package body Ch3 is
             Scan; -- past ALIASED
             Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
             Set_Aliased_Present (Decl_Node, True);
-            Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
 
             if Token = Tok_Constant then
                Scan; -- past CONSTANT
@@ -1363,11 +1357,8 @@ package body Ch3 is
                  (Decl_Node, P_Array_Type_Definition);
 
             else
-               if Extensions_Allowed then               --  Ada 0Y (AI-231)
-                  Not_Null_Present := P_Null_Exclusion;
-                  Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
-               end if;
-
+               Not_Null_Present := P_Null_Exclusion; --  Ada 0Y (AI-231)
+               Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
                Set_Object_Definition (Decl_Node,
                   P_Subtype_Indication (Not_Null_Present));
             end if;
@@ -1378,6 +1369,74 @@ package body Ch3 is
             Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
             Set_Object_Definition (Decl_Node, P_Array_Type_Definition);
 
+         --  Ada 0Y (AI-254)
+
+         elsif Token = Tok_Not then
+
+            --  OBJECT_DECLARATION ::=
+            --    DEFINING_IDENTIFIER_LIST : [aliased] [constant]
+            --      [NULL_EXCLUSION] SUBTYPE_INDICATION [:= EXPRESSION];
+
+            --  OBJECT_RENAMING_DECLARATION ::=
+            --    ...
+            --  | DEFINING_IDENTIFIER : ACCESS_DEFINITION renames object_NAME;
+
+            Not_Null_Present := P_Null_Exclusion; --  Ada 0Y (AI-231)
+
+            if Token = Tok_Access then
+               if not Extensions_Allowed then
+                  Error_Msg_SP
+                    ("generalized use of anonymous access types " &
+                     "is an Ada 0Y extension");
+                  Error_Msg_SP ("\unit must be compiled with -gnatX switch");
+               end if;
+
+               Acc_Node := P_Access_Definition (Not_Null_Present);
+
+               if Token /= Tok_Renames then
+                  Error_Msg_SC ("'RENAMES' expected");
+                  raise Error_Resync;
+               end if;
+
+               Scan; --  past renames
+               No_List;
+               Decl_Node :=
+                 New_Node (N_Object_Renaming_Declaration, Ident_Sloc);
+               Set_Access_Definition (Decl_Node, Acc_Node);
+               Set_Name (Decl_Node, P_Name);
+
+            else
+               Type_Node := P_Subtype_Mark;
+
+               --  Object renaming declaration
+
+               if Token_Is_Renames then
+                  Error_Msg_SP ("(Ada 0Y) null-exclusion not allowed in "
+                                & "object renamings");
+                  raise Error_Resync;
+
+               --  Object declaration
+
+               else
+                  Decl_Node := New_Node (N_Object_Declaration, Ident_Sloc);
+                  Set_Null_Exclusion_Present (Decl_Node, Not_Null_Present);
+                  Set_Object_Definition
+                    (Decl_Node,
+                     P_Subtype_Indication (Type_Node, Not_Null_Present));
+
+                  --  RENAMES at this point means that we had the combination
+                  --  of a constraint on the Type_Node and renames, which is
+                  --  illegal
+
+                  if Token_Is_Renames then
+                     Error_Msg_N ("constraint not allowed in object renaming "
+                                  & "declaration",
+                                  Constraint (Object_Definition (Decl_Node)));
+                     raise Error_Resync;
+                  end if;
+               end if;
+            end if;
+
          --  Ada 0Y (AI-230): Access Definition case
 
          elsif Token = Tok_Access then
@@ -1388,7 +1447,7 @@ package body Ch3 is
                Error_Msg_SP ("\unit must be compiled with -gnatX switch");
             end if;
 
-            Acc_Node := P_Access_Definition;
+            Acc_Node := P_Access_Definition (Null_Exclusion_Present => False);
 
             if Token /= Tok_Renames then
                Error_Msg_SC ("'RENAMES' expected");
@@ -1405,20 +1464,11 @@ package body Ch3 is
          --  Subtype indication case
 
          else
-            if Extensions_Allowed then                   --  Ada 0Y (AI-231)
-               Not_Null_Present := P_Null_Exclusion;
-            end if;
-
             Type_Node := P_Subtype_Mark;
 
             --  Object renaming declaration
 
             if Token_Is_Renames then
-               if Not_Null_Present then
-                  Error_Msg_SP
-                    ("(Ada 0Y) null-exclusion not allowed in renamings");
-               end if;
-
                No_List;
                Decl_Node :=
                  New_Node (N_Object_Renaming_Declaration, Ident_Sloc);
@@ -1551,11 +1601,8 @@ package body Ch3 is
          Scan;
       end if;
 
-      if Extensions_Allowed then                         --  Ada 0Y (AI-231)
-         Not_Null_Present := P_Null_Exclusion;
-         Set_Null_Exclusion_Present (Typedef_Node, Not_Null_Present);
-      end if;
-
+      Not_Null_Present := P_Null_Exclusion; --  Ada 0Y (AI-231)
+      Set_Null_Exclusion_Present (Typedef_Node, Not_Null_Present);
       Set_Subtype_Indication (Typedef_Node,
          P_Subtype_Indication (Not_Null_Present));
 
@@ -2130,6 +2177,7 @@ package body Ch3 is
       Not_Null_Present : Boolean := False;
       Subs_List        : List_Id;
       Scan_State       : Saved_Scan_State;
+      Aliased_Present  : Boolean := False;
 
    begin
       Array_Loc := Token_Ptr;
@@ -2189,6 +2237,17 @@ package body Ch3 is
 
       CompDef_Node := New_Node (N_Component_Definition, Token_Ptr);
 
+      if Token_Name = Name_Aliased then
+         Check_95_Keyword (Tok_Aliased, Tok_Identifier);
+      end if;
+
+      if Token = Tok_Aliased then
+         Aliased_Present := True;
+         Scan; -- past ALIASED
+      end if;
+
+      Not_Null_Present := P_Null_Exclusion; --  Ada 0Y (AI-231/AI-254)
+
       --  Ada 0Y (AI-230): Access Definition case
 
       if Token = Tok_Access then
@@ -2199,28 +2258,21 @@ package body Ch3 is
             Error_Msg_SP ("\unit must be compiled with -gnatX switch");
          end if;
 
-         Set_Subtype_Indication (CompDef_Node, Empty);
-         Set_Aliased_Present    (CompDef_Node, False);
-         Set_Access_Definition  (CompDef_Node, P_Access_Definition);
-      else
-         Set_Access_Definition  (CompDef_Node, Empty);
-
-         if Token_Name = Name_Aliased then
-            Check_95_Keyword (Tok_Aliased, Tok_Identifier);
-         end if;
-
-         if Token = Tok_Aliased then
-            Set_Aliased_Present (CompDef_Node, True);
-            Scan; -- past ALIASED
+         if Aliased_Present then
+            Error_Msg_SP ("ALIASED not allowed here");
          end if;
 
-         if Extensions_Allowed then                       --  Ada 0Y (AI-231)
-            Not_Null_Present := P_Null_Exclusion;
-            Set_Null_Exclusion_Present (CompDef_Node, Not_Null_Present);
-         end if;
+         Set_Subtype_Indication     (CompDef_Node, Empty);
+         Set_Aliased_Present        (CompDef_Node, False);
+         Set_Access_Definition      (CompDef_Node,
+           P_Access_Definition (Not_Null_Present));
+      else
 
-         Set_Subtype_Indication (CompDef_Node,
-            P_Subtype_Indication (Not_Null_Present));
+         Set_Access_Definition      (CompDef_Node, Empty);
+         Set_Aliased_Present        (CompDef_Node, Aliased_Present);
+         Set_Null_Exclusion_Present (CompDef_Node, Not_Null_Present);
+         Set_Subtype_Indication     (CompDef_Node,
+           P_Subtype_Indication (Not_Null_Present));
       end if;
 
       Set_Component_Definition (Def_Node, CompDef_Node);
@@ -2444,7 +2496,6 @@ 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 0Y (AI-231)
 
                if Token = Tok_Access then
@@ -2454,11 +2505,10 @@ package body Ch3 is
                   end if;
 
                   Set_Discriminant_Type
-                    (Specification_Node, P_Access_Definition);
-                  Set_Null_Exclusion_Present               --  Ada 0Y (AI-231)
-                    (Discriminant_Type (Specification_Node),
-                     Not_Null_Present);
+                    (Specification_Node,
+                     P_Access_Definition (Not_Null_Present));
                else
+
                   Set_Discriminant_Type
                     (Specification_Node, P_Subtype_Mark);
                   No_Constraint;
@@ -2876,6 +2926,7 @@ package body Ch3 is
    --  items, do we need to add this capability sometime in the future ???
 
    procedure P_Component_Items (Decls : List_Id) is
+      Aliased_Present  : Boolean := False;
       CompDef_Node     : Node_Id;
       Decl_Node        : Node_Id;
       Scan_State       : Saved_Scan_State;
@@ -2935,6 +2986,19 @@ package body Ch3 is
 
             CompDef_Node := New_Node (N_Component_Definition, Token_Ptr);
 
+            if Token_Name = Name_Aliased then
+               Check_95_Keyword (Tok_Aliased, Tok_Identifier);
+            end if;
+
+            if Token = Tok_Aliased then
+               Aliased_Present := True;
+               Scan; -- past ALIASED
+            end if;
+
+            Not_Null_Present := P_Null_Exclusion; --  Ada 0Y (AI-231/AI-254)
+
+            --  Ada 0Y (AI-230): Access Definition case
+
             if Token = Tok_Access then
                if not Extensions_Allowed then
                   Error_Msg_SP
@@ -2943,21 +3007,19 @@ package body Ch3 is
                   Error_Msg_SP ("\unit must be compiled with -gnatX switch");
                end if;
 
+               if Aliased_Present then
+                  Error_Msg_SP ("ALIASED not allowed here");
+               end if;
+
                Set_Subtype_Indication (CompDef_Node, Empty);
                Set_Aliased_Present    (CompDef_Node, False);
-               Set_Access_Definition  (CompDef_Node, P_Access_Definition);
+               Set_Access_Definition  (CompDef_Node,
+                 P_Access_Definition (Not_Null_Present));
             else
 
-               Set_Access_Definition (CompDef_Node, Empty);
-
-               if Token_Name = Name_Aliased then
-                  Check_95_Keyword (Tok_Aliased, Tok_Identifier);
-               end if;
-
-               if Token = Tok_Aliased then
-                  Scan; -- past ALIASED
-                  Set_Aliased_Present (CompDef_Node, True);
-               end if;
+               Set_Access_Definition      (CompDef_Node, Empty);
+               Set_Aliased_Present        (CompDef_Node, Aliased_Present);
+               Set_Null_Exclusion_Present (CompDef_Node, Not_Null_Present);
 
                if Token = Tok_Array then
                   Error_Msg_SC
@@ -2965,13 +3027,8 @@ package body Ch3 is
                   raise Error_Resync;
                end if;
 
-               if Extensions_Allowed then                 --  Ada 0Y (AI-231)
-                  Not_Null_Present := P_Null_Exclusion;
-                  Set_Null_Exclusion_Present (CompDef_Node, Not_Null_Present);
-               end if;
-
                Set_Subtype_Indication (CompDef_Node,
-                  P_Subtype_Indication (Not_Null_Present));
+                 P_Subtype_Indication (Not_Null_Present));
             end if;
 
             Set_Component_Definition (Decl_Node, CompDef_Node);
@@ -3231,15 +3288,18 @@ package body Ch3 is
 
    --  PARAMETER_AND_RESULT_PROFILE ::= [FORMAL_PART] RETURN SUBTYPE_MARK
 
-   --  The caller has checked that the initial token is ACCESS
+   --  Ada 0Y (AI-254): If Header_Already_Parsed then the caller has already
+   --  parsed the null_exclusion part and has also removed the ACCESS token;
+   --  otherwise the caller has just checked that the initial token is ACCESS
 
    --  Error recovery: can raise Error_Resync
 
-   function P_Access_Type_Definition return Node_Id is
-      Prot_Flag        : Boolean;
-      Access_Loc       : Source_Ptr;
-      Not_Null_Present : Boolean := False;
-      Type_Def_Node    : Node_Id;
+   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;
 
       procedure Check_Junk_Subprogram_Name;
       --  Used in access to subprogram definition cases to check for an
@@ -3266,13 +3326,11 @@ package body Ch3 is
    --  Start of processing for P_Access_Type_Definition
 
    begin
-      if Extensions_Allowed then                          --  Ada 0Y (AI-231)
-         Not_Null_Present := P_Null_Exclusion;
+      if not Header_Already_Parsed then
+         Not_Null_Present := P_Null_Exclusion;         --  Ada 0Y (AI-231)
+         Scan; -- past ACCESS
       end if;
 
-      Access_Loc := Token_Ptr;
-      Scan; -- past ACCESS
-
       if Token_Name = Name_Protected then
          Check_95_Keyword (Tok_Protected, Tok_Procedure);
          Check_95_Keyword (Tok_Protected, Tok_Function);
@@ -3366,33 +3424,74 @@ package body Ch3 is
 
    --  ACCESS_DEFINITION ::=
    --    [NULL_EXCLUSION] access [GENERAL_ACCESS_MODIFIER] SUBTYPE_MARK
+   --  | ACCESS_TO_SUBPROGRAM_DEFINITION
+   --
+   --  ACCESS_TO_SUBPROGRAM_DEFINITION
+   --    [NULL_EXCLUSION] access [protected] procedure PARAMETER_PROFILE
+   --  | [NULL_EXCLUSION] access [protected] function
+   --    PARAMETER_AND_RESULT_PROFILE
 
-   --  The caller has checked that the initial token is ACCESS
+   --  The caller has parsed the null-exclusion part and it has also checked
+   --  that the next token is ACCESS
 
    --  Error recovery: cannot raise Error_Resync
 
-   function P_Access_Definition return Node_Id is
-      Def_Node : Node_Id;
+   function P_Access_Definition
+     (Null_Exclusion_Present : Boolean) return Node_Id is
+      Def_Node  : Node_Id;
+      Subp_Node : Node_Id;
 
    begin
       Def_Node := New_Node (N_Access_Definition, Token_Ptr);
       Scan; -- past ACCESS
 
-      --  Ada 0Y (AI-231)
+      --  Ada 0Y (AI-254/AI-231)
 
       if Extensions_Allowed then
-         if Token = Tok_All then
-            Scan; -- past ALL
-            Set_All_Present (Def_Node);
 
-         elsif Token = Tok_Constant then
-            Scan; -- past CONSTANT
-            Set_Constant_Present (Def_Node);
+         --  Ada 0Y (AI-254): Access_To_Subprogram_Definition
+
+         if Token = Tok_Protected
+           or else Token = Tok_Procedure
+           or else Token = Tok_Function
+         then
+            Subp_Node :=
+              P_Access_Type_Definition (Header_Already_Parsed => True);
+            Set_Null_Exclusion_Present (Subp_Node, Null_Exclusion_Present);
+            Set_Access_To_Subprogram_Definition (Def_Node, Subp_Node);
+
+         --  Ada 0Y (AI-231)
+         --  [NULL_EXCLUSION] access [GENERAL_ACCESS_MODIFIER] SUBTYPE_MARK
+
+         else
+            Set_Null_Exclusion_Present (Def_Node, Null_Exclusion_Present);
+
+            if Token = Tok_All then
+               Scan; -- past ALL
+               Set_All_Present (Def_Node);
+
+            elsif Token = Tok_Constant then
+               Scan; -- past CONSTANT
+               Set_Constant_Present (Def_Node);
+            end if;
+
+            Set_Subtype_Mark (Def_Node, P_Subtype_Mark);
+            No_Constraint;
          end if;
+
+      --  Ada 95
+
+      else
+         --  Ada 0Y (AI-254): The null-exclusion present is never present
+         --  in Ada 83 and Ada 95
+
+         pragma Assert (Null_Exclusion_Present = False);
+
+         Set_Null_Exclusion_Present (Def_Node, False);
+         Set_Subtype_Mark (Def_Node, P_Subtype_Mark);
+         No_Constraint;
       end if;
 
-      Set_Subtype_Mark (Def_Node, P_Subtype_Mark);
-      No_Constraint;
       return Def_Node;
    end P_Access_Definition;