einfo.ads, einfo.adb (Is_Local_Anonymous_Access): New flag on anonymous access types...

2005-06-14  Ed Schonberg  <schonberg@adacore.com>
	    Javier Miranda  <miranda@adacore.com>
	    Thomas Quinot  <quinot@adacore.com>
	    Robert Dewar  <dewar@adacore.com>
	    Hristian Kirtchev  <kirtchev@adacore.com>
	    Gary Dismukes  <dismukes@adacore.com>

	* einfo.ads, einfo.adb (Is_Local_Anonymous_Access): New flag on
	anonymous access types, to indicate that the accessibility level of
	the type is determined by that of the enclosing declaration.
	(Has_Persistent_BSS): New flag
	(Set_Is_Primitive_Wrapper): Upgrade the barrier to allow the usage
	of this attribute with functions.
	(Is_Primitive_Wrapper): Remove the barrier.
	(Has_Specified_Stream_Input, Has_Specified_Stream_Output,
	Has_Specified_Stream_Read, Has_Specified_Stream_Write):
	New subprograms.
	(Set_Has_Specified_Stream_Input, Set_Has_Specified_Stream_Output,
	Set_Has_Specified_Stream_Read, Set_Has_Specified_Stream_Write):
	New subprograms.
	(Is_Pure_Unit_Access_Type): New flag
	(Abstract_Interfaces): Complete the assertion to cover all usages.
	(Set_Is_Interface): Complete the assertion to cover all usages.
	(Is_Primitive_Wrapper): New attribute.
	(Is_Obsolescent): Now applies to all entities (though it is only set
	for subprograms currently)
	New flag:  Has_Constrained_Partial_View, to implemente Ada 2005 AI-363,
	which solves various problems concerning access subtypes.
	(Has_Persistent_BSS): New flag
	(Is_Primitive_Wrapper, Set_Primitive_Wrapper): Code cleanup.
	Remove these subprograms because this attribute is currently
	not used.
	New entity flags:
	Has_Specified_Stream_Input (Flag190)
	Has_Specified_Stream_Output (Flag191)
	Has_Specified_Stream_Read (Flag192)
	Has_Specified_Stream_Write (Flag193)
	Present in all type and subtype entities. Set for a given view if the
	corresponding stream-oriented attribute has been defined by an
	attribute definition clause. When such a clause occurs, a TSS is set
	on the underlying full view; the flags are used to track visibility of
	the attribute definition clause for partial or incomplete views.
	(Is_Pure_Unit_Access_Type): New flag
	Clarify use of Is_Internal.
	(Is_Primitive_Wrapper): New attribute present in primitive subprograms
	internally generated to wrap the invocation of tasks and protected
	types that implement interfaces.
	(Implementation_Base_Type): Documentation correction
	(Is_Obsolescent): Now applies to all entities (though it is only set
	for subprograms currently)
	New flag:  Has_Constrained_Partial_View, to implement Ada 2005 AI-363,
	which solves various problems concerning access subtypes.

	* exp_ch9.adb (Type_Conformant_Parameters): Introduce mode conformance
	for examined parameters. Identify unequal parameter list lengths as
	non-conformant parameters.
	(Overriding_Possible): Do not check for "All" qualifier in declaration
	of controlling access parameter, following prescription of AI-404.
	(Build_Entry_Wrapper_Spec, Build_Entry_Wrapper_Body): New subprograms
	that build the procedure body that wraps an entry invocation
	(Build_Corresponding_Record, Build_Protected_Sub_Specification,
	Expand_N_Protected_Body, Expand_N_Protected_Type_Declaration,
	Expand_N_Task_Body, Expand_N_Task_Type_Declaration): Modified to
	give support to abstract interface types

	* freeze.adb (Freeze_Entity): Issue error message if
	Is_Pure_Unit_Access_Type set, unless we are in Ada 2005 mode and the
	type has no storage pool (Ada 2005) AI-366.
	Also modified to give support to abstract interface types
	(Freeze_Subprogram): Issue an error for a dispatching subprogram with an
	Inline_Always pragma.

	* par-ch9.adb (P_Task_Items): Reserved words "not" or "overriding" may
	now begin an entry declaration.
	(P_Entry_Or_Subprogram_With_Indicator): New procedure in
	P_Protected_Operation_Declaration_Opt. Parse an entry declaration or
	a subprogram declaration preceded by an overriding indicator.
	(P_Protected_Operation_Declaration_Opt): Add case for parsing entry
	declarations or subprogram declarations preceded by reserved words
	"not" or "overriding".
	(P_Entry_Declaration): Update comment. Parse and check overriding
	indicator, set semantic flags of entry declarations.
	(P_Task): New error message in case of private applied
	to a task type declaration.
	(P_Protected): New error message in case of private applied
	to a task type declaration.

	* sem_ch7.adb (Preserve_Full_Attributes): Modified to handle the case
	in which the full view of a type implementing an interface is a
	concurrent type.
	(Has_Overriding_Pragma): Remove obsolete implementation of AI-218.
	Declare_Inherited_Private_Subprograms): If an explicit operation
	overrides an operation that is inherited in the private part, mark the
	explicit one as overriding, to enable overriding indicator checks.
	(Preserve_Full_Attributes): Propagate Is_Unchecked_Union attribute from
	full view to partial view, to simplify handling in back-end.

	* sprint.adb: Print interface lists where needed: derived types,
	protected types, task types.
	output "is null" for null procedures. Part of implementation of

	* sem_cat.adb (Validate_Access_Type_Declaration): Implement AI-366
	relaxation of rules for access types in pure, shared passive partitions.

	* exp_strm.adb (Build_Mutable_Record_Read_Procedure): Reorganize to
	first read discriminants into temporary objects, performing checks on
	the read values, then possibly performing discriminant checks on the
	actual (if it is constrained), and only finally reading the components
	into a constrained temporary object.
	(Build_Elementary_Input_Call): Adjust the specific circuitry for the
	case of reading discriminants of a mutable record type to recognize
	the new form of the code generated by
	Build_Mutable_Record_Read_Procedure.

	* exp_tss.ads, exp_tss.adb (Make_Init_Proc_Name): Reimplement in terms
	of a simple call to Make_TSS_Name.
	(Make_TSS_Name_Local): Add the TSS name as the last thing in the name
	buffer, in order for Is_TSS to work correctly on local TSS names.

	* sem_attr.ads, sem_attr.adb (Resolve_Attribute, case 'Access): Use flag
	Is_Local_Anonymous_Access to check legaliy of attributes in the
	context of  access components and stand-alone access objects.
	(Stream_Attribute_Available): In Ada 95 mode, a stream attribute is
	treated as available for a limited private type if there is an
	attribute_definition_clause that applies to its full view, but not in
	other cases where the attribute is available for the full view
	(specifically, the sole fact that the full view is non-limited does not
	make the attribute available for the partial view).
	(Build_Access_Subprogram_Type): Diagnose attempt to apply 'access to a
	non-overloaded intrinsic subprogram.
	(Check_Stream_Attribute): Reject an attribute reference for an
	unavailable stream attribute even if the prefix is not a limited type
	(case of a 'Input attribute reference for an abstract, non-classwide
	type)
	(Stream_Attribute_Available): New function to determine whether a stream
	attribute is available at a place.
	(Check_Attribute): Use Stream_Attribute_Available instead of just
	testing for TSS presence on the implementation base type.
	(Analyze_Attribute): Modified to give support to task interfaces.
	(Analyze_Access_Attribute): Add error check for use of an Access (or
	Unrestricted_Access) attribute with a subprogram marked as
	Inline_Always.
	(Analyze_Attribute, case Attribute_Address): Add error check for use of
	an Address attribute with a subprogram marked as Inline_Always.
	Update Eval_Attribute to handle new value of Width from AI-395

	* sem_ch13.adb (Analyze_Stream_TSS_Definition): New subprogram.
	(Analyze_Attribute_Definition_Clause, cases Input, Output, Read, Write):
	Factor common code across the stream-oriented attribute circcuits into
	a new subprogram, Analyze_Stream_TSS_Definition. The new uniform
	processing is functionally identical to the previous duplicated one,
	except that an expression that denotes an abstract subprogram will now
	be rejected, as mandated by AI-195 item 5.

	* sem_util.ads, sem_util.adb (Type_Access_Level): Use flag
	Is_Local_Anonymous_Access to apply accessibility checks to access
	components and stand-alone access objects.
	(Has_Discriminant_Dependent_Constraint): Moved to spec for use
	elsewhere.
	(Is_Potentially_Persistent_Type): New function
	(Is_Dependent_Component_Of_Mutable_Object): If the enclosing object is
	a heap-object whose type has a constrained partial view, the object is
	unconstrained and the component may depend on a discriminant, making its
	renaming illegal.

	* sinfo.ads, sinfo.adb
	(Must_Not_Override): Flag applicable to N_Entry_Declaration.
	(Must_Override): Flag applicable to N_Entry_Declaration.
	Indicate that interface_list can appear in single task and single
	protected declarations.
	Replace Is_Overriding and Not_Overriding with Must_Override and
	Must_Not_Override, to better express intent of AI.
	Is_Overriding, Not_Overriding: Ada2005 flags that indicate the presence
	of an overriding indicator in a subprogram or instance.
	Ada 2005 (AI-248) Null_Present can appear in a procedure specification.
	Add the overriding indicator [[not] overriding] construct to the
	following grammar productions:
	 ENTRY_DECLARATION
	 GENERIC_INSTANTIATION
	 SUBPROGRAM_SPECIFICATION

	* par-ch10.adb (P_Compilation_Unit): Subprogram declaration or body
	can start with an overriding indicator.

	* par-ch6.adb (P_Subprogram): Recognize overriding indicator, and set
	flags accordingly on subrogram specifications or instances.

	* sem_ch8.adb:
	(Analyze_Subprogram_Renaming): For a renaming_as_body, verify that the
	overriding_indicator, if present, is consistent with status of spec.
	Improve error message for null-excluding checks on controlling access
	parameters.
	(Check_In_Previous_With_Clause): Protect the frontend against
	previously reported critical errors in the context clauses.
	Save and restore Ada_Version_Explicit, for implementation of AI-362
	(Analyze_Subprogram_Renaming): If the new entity is a dispatching
	operation verify that controlling formals of the renamed entity that
	are access parameters are explicitly non-null.
	(Find_Expanded_Name): Improve error message when prefix is an illegal
	reference to a private child unit.

	* exp_imgv.adb, s-imgwch.ads, s-imgwch.adb, s-valwch.adb,
	s-valwch.ads, s-widwch.adb, s-widwch.ads, s-wwdcha.adb, s-wwdwch.adb:
	Rewrite to correspond to new wide character names in AI-395

        * par-ch12.adb (P_Formal_Subprogram_Declaration): Recognize null
        default procedures.

From-SVN: r101029

1 files changed, 102 insertions, 31 deletions

diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 394f6db..ee920be 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -1101,6 +1101,7 @@ package body Sem_Ch8 is
    procedure Analyze_Subprogram_Renaming (N : Node_Id) is
       Spec        : constant Node_Id          := Specification (N);
       Save_AV     : constant Ada_Version_Type := Ada_Version;
+      Save_AV_Exp : constant Ada_Version_Type := Ada_Version_Explicit;
       Nam         : constant Node_Id          := Name (N);
       New_S       : Entity_Id;
       Old_S       : Entity_Id                 := Empty;
@@ -1357,9 +1358,24 @@ package body Sem_Ch8 is
          New_S := Rename_Spec;
          Set_Has_Completion (Rename_Spec, False);
 
+         --  Ada 2005: check overriding indicator.
+
+         if Must_Override (Specification (N))
+           and then not Is_Overriding_Operation (Rename_Spec)
+         then
+            Error_Msg_NE ("subprogram& is not overriding", N, Rename_Spec);
+
+         elsif Must_Not_Override (Specification (N))
+           and then Is_Overriding_Operation (Rename_Spec)
+         then
+            Error_Msg_NE
+              ("subprogram& overrides inherited operation", N, Rename_Spec);
+         end if;
+
       else
          Generate_Definition (New_S);
          New_Overloaded_Entity (New_S);
+
          if Is_Entity_Name (Nam)
            and then Is_Intrinsic_Subprogram (Entity (Nam))
          then
@@ -1422,12 +1438,15 @@ package body Sem_Ch8 is
          Set_Has_Completion (New_S);
       end if;
 
-      --  Find the renamed entity that matches the given specification.
-      --  Disable Ada_83 because there is no requirement of full conformance
-      --  between renamed entity and new entity, even though the same circuit
-      --  is used.
+      --  Find the renamed entity that matches the given specification. Disable
+      --  Ada_83 because there is no requirement of full conformance between
+      --  renamed entity and new entity, even though the same circuit is used.
+      --  This is a bit of a kludge, which introduces a really irregular use of
+      --  Ada_Version[_Explicit]. Would be nice to find cleaner way to do this
+      --  ???
 
       Ada_Version := Ada_Version_Type'Max (Ada_Version, Ada_95);
+      Ada_Version_Explicit := Ada_Version;
 
       if No (Old_S) then
          Old_S := Find_Renamed_Entity (N, Name (N), New_S, Is_Actual);
@@ -1444,11 +1463,10 @@ package body Sem_Ch8 is
             Generate_Reference (Old_S, Nam);
          end if;
 
-         --  For a renaming-as-body, require subtype conformance,
-         --  but if the declaration being completed has not been
-         --  frozen, then inherit the convention of the renamed
-         --  subprogram prior to checking conformance (unless the
-         --  renaming has an explicit convention established; the
+         --  For a renaming-as-body, require subtype conformance, but if the
+         --  declaration being completed has not been frozen, then inherit the
+         --  convention of the renamed subprogram prior to checking conformance
+         --  (unless the renaming has an explicit convention established; the
          --  rule stated in the RM doesn't seem to address this ???).
 
          if Present (Rename_Spec) then
@@ -1516,15 +1534,15 @@ package body Sem_Ch8 is
                Set_Alias (New_S, Old_S);
             end if;
 
-            --  Note that we do not set Is_Intrinsic_Subprogram if we have
-            --  a renaming as body, since the entity in this case is not an
-            --  intrinsic (it calls an intrinsic, but we have a real body
-            --  for this call, and it is in this body that the required
-            --  intrinsic processing will take place).
+            --  Note that we do not set Is_Intrinsic_Subprogram if we have a
+            --  renaming as body, since the entity in this case is not an
+            --  intrinsic (it calls an intrinsic, but we have a real body for
+            --  this call, and it is in this body that the required intrinsic
+            --  processing will take place).
 
-            --  Also, if this is a renaming of inequality, the renamed
-            --  operator is intrinsic, but what matters is the corresponding
-            --  equality operator, which may be user-defined.
+            --  Also, if this is a renaming of inequality, the renamed operator
+            --  is intrinsic, but what matters is the corresponding equality
+            --  operator, which may be user-defined.
 
             Set_Is_Intrinsic_Subprogram
               (New_S,
@@ -1594,9 +1612,9 @@ package body Sem_Ch8 is
          Set_Is_Abstract (New_S, Is_Abstract (Old_S));
          Check_Library_Unit_Renaming (N, Old_S);
 
-         --  Pathological case: procedure renames entry in the scope of
-         --  its task. Entry is given by simple name, but body must be built
-         --  for procedure. Of course if called it will deadlock.
+         --  Pathological case: procedure renames entry in the scope of its
+         --  task. Entry is given by simple name, but body must be built for
+         --  procedure. Of course if called it will deadlock.
 
          if Ekind (Old_S) = E_Entry then
             Set_Has_Completion (New_S, False);
@@ -1621,11 +1639,11 @@ package body Sem_Ch8 is
          end if;
 
       else
-         --  A common error is to assume that implicit operators for types
-         --  are defined in Standard, or in the scope of a subtype. In those
-         --  cases where the renamed entity is given with an expanded name,
-         --  it is worth mentioning that operators for the type are not
-         --  declared in the scope given by the prefix.
+         --  A common error is to assume that implicit operators for types are
+         --  defined in Standard, or in the scope of a subtype. In those cases
+         --  where the renamed entity is given with an expanded name, it is
+         --  worth mentioning that operators for the type are not declared in
+         --  the scope given by the prefix.
 
          if Nkind (Nam) = N_Expanded_Name
            and then Nkind (Selector_Name (Nam)) = N_Operator_Symbol
@@ -1675,7 +1693,40 @@ package body Sem_Ch8 is
          end if;
       end if;
 
+      --  Ada 2005 AI 404: if the new subprogram is dispatching, verify that
+      --  controlling access parameters are known non-null for the renamed
+      --  subprogram. Test also applies to a subprogram instantiation that
+      --  is dispatching.
+
+      if Ada_Version >= Ada_05
+        and then not Is_Dispatching_Operation (Old_S)
+        and then Is_Dispatching_Operation (New_S)
+      then
+         declare
+            Old_F : Entity_Id;
+            New_F : Entity_Id;
+
+         begin
+            Old_F := First_Formal (Old_S);
+            New_F := First_Formal (New_S);
+            while Present (Old_F) loop
+               if Ekind (Etype (Old_F)) = E_Anonymous_Access_Type
+                 and then Is_Controlling_Formal (New_F)
+                 and then not Can_Never_Be_Null (Old_F)
+               then
+                  Error_Msg_N ("access parameter is controlling,", New_F);
+                  Error_Msg_NE ("\corresponding parameter of& " &
+                    " must be explicitly null excluding", New_F, Old_S);
+               end if;
+
+               Next_Formal (Old_F);
+               Next_Formal (New_F);
+            end loop;
+         end;
+      end if;
+
       Ada_Version := Save_AV;
+      Ada_Version_Explicit := Save_AV_Exp;
    end Analyze_Subprogram_Renaming;
 
    -------------------------
@@ -1699,9 +1750,9 @@ package body Sem_Ch8 is
       Set_Hidden_By_Use_Clause (N, No_Elist);
 
       --  Use clause is not allowed in a spec of a predefined package
-      --  declaration except that packages whose file name starts a-n
-      --  are OK (these are children of Ada.Numerics, and such packages
-      --  are never loaded by Rtsfind).
+      --  declaration except that packages whose file name starts a-n are OK
+      --  (these are children of Ada.Numerics, and such packages are never
+      --  loaded by Rtsfind).
 
       if Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit))
         and then Name_Buffer (1 .. 3) /= "a-n"
@@ -1809,7 +1860,7 @@ package body Sem_Ch8 is
 
             if Nkind (Parent (N)) = N_Compilation_Unit then
                if  Nkind (Id) = N_Identifier then
-                  Error_Msg_N ("Type is not directly visible", Id);
+                  Error_Msg_N ("type is not directly visible", Id);
 
                elsif Is_Child_Unit (Scope (Entity (Id)))
                  and then Scope (Entity (Id)) /= System_Aux_Id
@@ -2130,6 +2181,11 @@ package body Sem_Ch8 is
         and then Item /= N
       loop
          if Nkind (Item) = N_With_Clause
+
+            --  Protect the frontend against previously reported
+            --  critical errors
+
+           and then Nkind (Name (Item)) /= N_Selected_Component
            and then Entity (Name (Item)) = Pack
          then
             Par := Nam;
@@ -3570,8 +3626,23 @@ package body Sem_Ch8 is
             if Present (Candidate) then
 
                if Is_Child_Unit (Candidate) then
-                  Error_Msg_N
-                    ("missing with_clause for child unit &", Selector);
+
+                  --  If the candidate is a private child unit and we are
+                  --  in the visible part of a public unit, specialize the
+                  --  error message. There might be a private with_clause for
+                  --  it, but it is not currently active.
+
+                  if Is_Private_Descendant (Candidate)
+                    and then Ekind (Current_Scope) = E_Package
+                    and then not In_Private_Part (Current_Scope)
+                    and then not Is_Private_Descendant (Current_Scope)
+                  then
+                     Error_Msg_N ("private child unit& is not visible here",
+                       Selector);
+                  else
+                     Error_Msg_N
+                       ("missing with_clause for child unit &", Selector);
+                  end if;
                else
                   Error_Msg_NE ("& is not a visible entity of&", N, Selector);
                end if;