sem_ch4.adb (Complete_Object_Operation): Do not insert 'Access for reference types in the access-to-access case.

gcc/ada/

2017-09-18  Bob Duff  <duff@adacore.com>

	* sem_ch4.adb (Complete_Object_Operation): Do not insert 'Access for
	reference types in the access-to-access case.

2017-09-18  Eric Botcazou  <ebotcazou@adacore.com>

	* sem_attr.adb (Analyze_Access_Attribute): Move check for the presence
	of the "aliased" keyword on the prefix from here to...
	(Resolve_Attribute) <Attribute_Access>: ...here.  Remove useless call
	to Check_No_Implicit_Aliasing.
	* sinfo.ads (Non_Aliased_Prefix): Delete.
	(Set_Non_Aliased_Prefix): Likewise.
	* sinfo.adb (Non_Aliased_Prefix): Delete.
	(Set_Non_Aliased_Prefix): Likewise.

2017-09-18  Bob Duff  <duff@adacore.com>

	* exp_ch5.adb (Build_Formal_Container_Iteration,
	Expand_Formal_Container_Element_Loop): Convert the container to the
	root type before passing it to the iteration operations, so it will be
	of the right type.

2017-09-18  Bob Duff  <duff@adacore.com>

	* einfo.ads, validsw.ads, treepr.ads, sem_util.ads: Comment fixes.

2017-09-18  Bob Duff  <duff@adacore.com>

	* exp_ch3.adb (Build_Array_Init_Proc): If validity checking is enabled,
	and it's a bit-packed array, pass False to the Consider_IS parameter of
	Needs_Simple_Initialization.

2017-09-18  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch6.adb (Check_Inline_Pragma): Link the newly generated spec to
	the preexisting body.
	* sem_prag.adb (Check_Inline_Always_Placement): New routine.
	(Process_Inline): Verify the placement of pragma Inline_Always. The
	pragma must now appear on the initial declaration of the related
	subprogram.

2017-09-18  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Analyze_Declarations): In ASIS mode,  At the end of the
	declarative list in a subprogram body, analyze aspext specifications to
	provide basic semantic information, because otherwise the aspect
	specifications might only be snalyzed during expansion, when related
	subprograms are generated.

2017-09-18  Bob Duff  <duff@adacore.com>

	* exp_ch9.adb (Is_Simple_Barrier_Name): Follow Original_Node, in case
	validity checks have rewritten the tree.

2017-09-18  Bob Duff  <duff@adacore.com>

	* sem_util.adb: Comment fixes, and remove redundant Is_Itype check.

2017-09-18  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Save_References_In_Aggregate): When constructing a
	qualified exxpression for an aggregate in a generic unit, verify that
	the scope of the type is itself visible and not hidden, so that the
	qualified expression is correctly resolved in any instance.

gcc/testsuite/

2017-09-18  Bob Duff  <duff@adacore.com>

	* gnat.dg/validity_check.adb: New testcase.

2017-09-18  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/overload.ads, gnat.dg/overload.adb: New testcase.

2017-09-18  Bob Duff  <duff@adacore.com>

	* gnat.dg/tagged_prefix_call.adb: New testcase.

From-SVN: r252916

22 files changed, 545 insertions, 154 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5dba677..b90a262 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,71 @@
 2017-09-18  Bob Duff  <duff@adacore.com>
 
+	* sem_ch4.adb (Complete_Object_Operation): Do not insert 'Access for
+	reference types in the access-to-access case.
+
+2017-09-18  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* sem_attr.adb (Analyze_Access_Attribute): Move check for the presence
+	of the "aliased" keyword on the prefix from here to...
+	(Resolve_Attribute) <Attribute_Access>: ...here.  Remove useless call
+	to Check_No_Implicit_Aliasing.
+	* sinfo.ads (Non_Aliased_Prefix): Delete.
+	(Set_Non_Aliased_Prefix): Likewise.
+	* sinfo.adb (Non_Aliased_Prefix): Delete.
+	(Set_Non_Aliased_Prefix): Likewise.
+
+2017-09-18  Bob Duff  <duff@adacore.com>
+
+	* exp_ch5.adb (Build_Formal_Container_Iteration,
+	Expand_Formal_Container_Element_Loop): Convert the container to the
+	root type before passing it to the iteration operations, so it will be
+	of the right type.
+
+2017-09-18  Bob Duff  <duff@adacore.com>
+
+	* einfo.ads, validsw.ads, treepr.ads, sem_util.ads: Comment fixes.
+
+2017-09-18  Bob Duff  <duff@adacore.com>
+
+	* exp_ch3.adb (Build_Array_Init_Proc): If validity checking is enabled,
+	and it's a bit-packed array, pass False to the Consider_IS parameter of
+	Needs_Simple_Initialization.
+
+2017-09-18  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_ch6.adb (Check_Inline_Pragma): Link the newly generated spec to
+	the preexisting body.
+	* sem_prag.adb (Check_Inline_Always_Placement): New routine.
+	(Process_Inline): Verify the placement of pragma Inline_Always. The
+	pragma must now appear on the initial declaration of the related
+	subprogram.
+
+2017-09-18  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Analyze_Declarations): In ASIS mode,  At the end of the
+	declarative list in a subprogram body, analyze aspext specifications to
+	provide basic semantic information, because otherwise the aspect
+	specifications might only be snalyzed during expansion, when related
+	subprograms are generated.
+
+2017-09-18  Bob Duff  <duff@adacore.com>
+
+	* exp_ch9.adb (Is_Simple_Barrier_Name): Follow Original_Node, in case
+	validity checks have rewritten the tree.
+
+2017-09-18  Bob Duff  <duff@adacore.com>
+
+	* sem_util.adb: Comment fixes, and remove redundant Is_Itype check.
+
+2017-09-18  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch12.adb (Save_References_In_Aggregate): When constructing a
+	qualified exxpression for an aggregate in a generic unit, verify that
+	the scope of the type is itself visible and not hidden, so that the
+	qualified expression is correctly resolved in any instance.
+
+2017-09-18  Bob Duff  <duff@adacore.com>
+
 	* sem_ch4.adb (Analyze_Qualified_Expression): Give an error if the type
 	mark refers to the current instance. Set the type to Any_Type in that
 	case, to avoid later crashes.
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 22a8b73..13bf620 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -323,7 +323,7 @@ package Einfo is
 --  only].  These are representation attributes which must always apply to a
 --  full non-private type, and where the attributes are always on the full
 --  type. The attribute can be referenced on a subtype (and automatically
---  retries the value from the implementation base type). However, it is an
+--  retrieves the value from the implementation base type). However, it is an
 --  error to try to set the attribute on other than the implementation base
 --  type, and if assertions are enabled, an attempt to set the attribute on a
 --  subtype will raise an assert error.
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 0fcf723..6e90fb6 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -517,6 +517,10 @@ package body Exp_Ch3 is
 
    procedure Build_Array_Init_Proc (A_Type : Entity_Id; Nod : Node_Id) is
       Comp_Type        : constant Entity_Id  := Component_Type (A_Type);
+      Comp_Type_Simple : constant Boolean :=
+        Needs_Simple_Initialization
+          (Comp_Type, Consider_IS =>
+             not (Validity_Check_Copies and Is_Bit_Packed_Array (A_Type)));
       Body_Stmts       : List_Id;
       Has_Default_Init : Boolean;
       Index_List       : List_Id;
@@ -557,7 +561,7 @@ package body Exp_Ch3 is
                   Convert_To (Comp_Type,
                     Default_Aspect_Component_Value (First_Subtype (A_Type)))));
 
-         elsif Needs_Simple_Initialization (Comp_Type) then
+         elsif Comp_Type_Simple then
             Set_Assignment_OK (Comp);
             return New_List (
               Make_Assignment_Statement (Loc,
@@ -589,7 +593,7 @@ package body Exp_Ch3 is
          --  the dummy Init_Proc needed for Initialize_Scalars processing.
 
          if not Has_Non_Null_Base_Init_Proc (Comp_Type)
-           and then not Needs_Simple_Initialization (Comp_Type)
+           and then not Comp_Type_Simple
            and then not Has_Task (Comp_Type)
            and then not Has_Default_Aspect (A_Type)
          then
@@ -679,7 +683,7 @@ package body Exp_Ch3 is
       --  init_proc.
 
       Has_Default_Init := Has_Non_Null_Base_Init_Proc (Comp_Type)
-                            or else Needs_Simple_Initialization (Comp_Type)
+                            or else Comp_Type_Simple
                             or else Has_Task (Comp_Type)
                             or else Has_Default_Aspect (A_Type);
 
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index d8d22d0..e682bfd 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -74,6 +74,12 @@ package body Exp_Ch5 is
    --  Utility to create declarations and loop statement for both forms
    --  of formal container iterators.
 
+   function Convert_To_Iterable_Type
+     (Container : Entity_Id; Loc : Source_Ptr) return Node_Id;
+   --  Returns New_Occurrence_Of (Container), possibly converted to an
+   --  ancestor type, if the type of Container inherited the Iterable
+   --  aspect_specification from that ancestor.
+
    function Change_Of_Representation (N : Node_Id) return Boolean;
    --  Determine if the right-hand side of assignment N is a type conversion
    --  which requires a change of representation. Called only for the array
@@ -189,7 +195,7 @@ package body Exp_Ch5 is
             Make_Function_Call (Loc,
               Name                   => New_Occurrence_Of (First_Op, Loc),
               Parameter_Associations => New_List (
-                New_Occurrence_Of (Container, Loc))));
+                Convert_To_Iterable_Type (Container, Loc))));
 
       --  Statement that advances cursor in loop
 
@@ -200,7 +206,7 @@ package body Exp_Ch5 is
             Make_Function_Call (Loc,
               Name                   => New_Occurrence_Of (Next_Op, Loc),
               Parameter_Associations => New_List (
-                New_Occurrence_Of (Container, Loc),
+                Convert_To_Iterable_Type (Container, Loc),
                 New_Occurrence_Of (Cursor, Loc))));
 
       --  Iterator is rewritten as a while_loop
@@ -211,13 +217,12 @@ package body Exp_Ch5 is
             Make_Iteration_Scheme (Loc,
               Condition =>
                 Make_Function_Call (Loc,
-                  Name                   =>
-                    New_Occurrence_Of (Has_Element_Op, Loc),
+                  Name => New_Occurrence_Of (Has_Element_Op, Loc),
                   Parameter_Associations => New_List (
-                    New_Occurrence_Of (Container, Loc),
+                    Convert_To_Iterable_Type (Container, Loc),
                     New_Occurrence_Of (Cursor, Loc)))),
-          Statements       => Stats,
-          End_Label        => Empty);
+          Statements => Stats,
+          End_Label  => Empty);
    end Build_Formal_Container_Iteration;
 
    ------------------------------
@@ -233,6 +238,26 @@ package body Exp_Ch5 is
             not Same_Representation (Etype (Rhs), Etype (Expression (Rhs)));
    end Change_Of_Representation;
 
+   ------------------------------
+   -- Convert_To_Iterable_Type --
+   ------------------------------
+
+   function Convert_To_Iterable_Type
+     (Container : Entity_Id; Loc : Source_Ptr) return Node_Id
+   is
+      Typ    : constant Entity_Id  := Base_Type (Etype (Container));
+      Aspect : constant Node_Id := Find_Aspect (Typ, Aspect_Iterable);
+      Result : Node_Id := New_Occurrence_Of (Container, Loc);
+   begin
+      if Entity (Aspect) /= Typ then
+         Result := Make_Type_Conversion (Loc,
+                     Subtype_Mark => New_Occurrence_Of (Entity (Aspect), Loc),
+                     Expression   => Result);
+      end if;
+
+      return Result;
+   end Convert_To_Iterable_Type;
+
    -------------------------
    -- Expand_Assign_Array --
    -------------------------
@@ -3207,7 +3232,7 @@ package body Exp_Ch5 is
            Make_Function_Call (Loc,
              Name                   => New_Occurrence_Of (Element_Op, Loc),
              Parameter_Associations => New_List (
-               New_Occurrence_Of (Container, Loc),
+               Convert_To_Iterable_Type (Container, Loc),
                New_Occurrence_Of (Cursor, Loc))));
 
          Set_Statements (New_Loop,
@@ -3226,7 +3251,7 @@ package body Exp_Ch5 is
                Make_Function_Call (Loc,
                  Name                   => New_Occurrence_Of (Element_Op, Loc),
                  Parameter_Associations => New_List (
-                   New_Occurrence_Of (Container, Loc),
+                   Convert_To_Iterable_Type (Container, Loc),
                    New_Occurrence_Of (Cursor, Loc))));
 
          Prepend (Elmt_Ref, Stats);
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 64bc84a..0cd4fde 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -6000,11 +6000,13 @@ package body Exp_Ch9 is
 
       begin
          --  Check if the name is a component of the protected object. If
-         --  the expander is active, the component has been transformed into
-         --  a renaming of _object.all.component.
+         --  the expander is active, the component has been transformed into a
+         --  renaming of _object.all.component. Original_Node is needed in case
+         --  validity checking is enabled, in which case the simple object
+         --  reference will have been rewritten.
 
          if Expander_Active then
-            Renamed := Renamed_Object (Entity (N));
+            Renamed := Renamed_Object (Entity (Original_Node (N)));
 
             return
               Present (Renamed)
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 641ac87..9500b1a 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -1074,49 +1074,6 @@ package body Sem_Attr is
                end if;
             end loop;
          end;
-
-         --  Check for aliased view. We allow a nonaliased prefix when within
-         --  an instance because the prefix may have been a tagged formal
-         --  object, which is defined to be aliased even when the actual
-         --  might not be (other instance cases will have been caught in the
-         --  generic). Similarly, within an inlined body we know that the
-         --  attribute is legal in the original subprogram, and therefore
-         --  legal in the expansion.
-
-         if not Is_Aliased_View (P)
-           and then not In_Instance
-           and then not In_Inlined_Body
-           and then Comes_From_Source (N)
-         then
-            --  Here we have a non-aliased view. This is illegal unless we
-            --  have the case of Unrestricted_Access, where for now we allow
-            --  this (we will reject later if expected type is access to an
-            --  unconstrained array with a thin pointer).
-
-            --  No need for an error message on a generated access reference
-            --  for the controlling argument in a dispatching call: error will
-            --  be reported when resolving the call.
-
-            if Aname /= Name_Unrestricted_Access then
-               Error_Attr_P ("prefix of % attribute must be aliased");
-               Check_No_Implicit_Aliasing (P);
-
-            --  For Unrestricted_Access, record that prefix is not aliased
-            --  to simplify legality check later on.
-
-            else
-               Set_Non_Aliased_Prefix (N);
-            end if;
-
-         --  If we have an aliased view, and we have Unrestricted_Access, then
-         --  output a warning that Unchecked_Access would have been fine, and
-         --  change the node to be Unchecked_Access.
-
-         else
-            --  For now, hold off on this change ???
-
-            null;
-         end if;
       end Analyze_Access_Attribute;
 
       ----------------------------------
@@ -11120,24 +11077,56 @@ package body Sem_Attr is
                end if;
             end if;
 
-            --  Check for unrestricted access where expected type is a thin
-            --  pointer to an unconstrained array.
-
-            if Non_Aliased_Prefix (N)
-              and then Has_Size_Clause (Typ)
-              and then RM_Size (Typ) = System_Address_Size
+            --  Check for aliased view. We allow a nonaliased prefix when in
+            --  an instance because the prefix may have been a tagged formal
+            --  object, which is defined to be aliased even when the actual
+            --  might not be (other instance cases will have been caught in
+            --  the generic). Similarly, within an inlined body we know that
+            --  the attribute is legal in the original subprogram, therefore
+            --  legal in the expansion.
+
+            if not (Is_Entity_Name (P)
+                     and then Is_Overloadable (Entity (P)))
+              and then not (Nkind (P) = N_Selected_Component
+                             and then
+                            Is_Overloadable (Entity (Selector_Name (P))))
+              and then not Is_Aliased_View (P)
+              and then not In_Instance
+              and then not In_Inlined_Body
+              and then Comes_From_Source (N)
             then
-               declare
-                  DT : constant Entity_Id := Designated_Type (Typ);
-               begin
-                  if Is_Array_Type (DT) and then not Is_Constrained (DT) then
-                     Error_Msg_N
-                       ("illegal use of Unrestricted_Access attribute", P);
-                     Error_Msg_N
-                       ("\attempt to generate thin pointer to unaliased "
-                        & "object", P);
-                  end if;
-               end;
+               --  Here we have a non-aliased view. This is illegal unless we
+               --  have the case of Unrestricted_Access, where for now we allow
+               --  this (we will reject later if expected type is access to an
+               --  unconstrained array with a thin pointer).
+
+               --  No need for an error message on a generated access reference
+               --  for the controlling argument in a dispatching call: error
+               --  will be reported when resolving the call.
+
+               if Attr_Id /= Attribute_Unrestricted_Access then
+                  Error_Msg_N ("prefix of % attribute must be aliased", P);
+
+               --  Check for unrestricted access where expected type is a thin
+               --  pointer to an unconstrained array.
+
+               elsif Has_Size_Clause (Typ)
+                 and then RM_Size (Typ) = System_Address_Size
+               then
+                  declare
+                     DT : constant Entity_Id := Designated_Type (Typ);
+                  begin
+                     if Is_Array_Type (DT)
+                       and then not Is_Constrained (DT)
+                     then
+                        Error_Msg_N
+                          ("illegal use of Unrestricted_Access attribute", P);
+                        Error_Msg_N
+                          ("\attempt to generate thin pointer to unaliased "
+                           & "object", P);
+                     end if;
+                  end;
+               end if;
             end if;
 
             --  Mark that address of entity is taken in case of
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 86d2808..058809e 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -15118,10 +15118,10 @@ package body Sem_Ch12 is
                --  preserved. In order to preserve some of this information,
                --  wrap the aggregate in a qualified expression, using the id
                --  of its type. For further disambiguation we qualify the type
-               --  name with its scope (if visible) because both id's will have
-               --  corresponding entities in an instance. This resolves most of
-               --  the problems with missing type information on aggregates in
-               --  instances.
+               --  name with its scope (if visible and not hidden by a local
+               --  homograph) because both id's will have corresponding
+               --  entities in an instance. This resolves most of the problems
+               --  with missing type information on aggregates in instances.
 
                if Present (N2)
                  and then Nkind (N2) = Nkind (N)
@@ -15131,7 +15131,9 @@ package body Sem_Ch12 is
                then
                   Nam := Make_Identifier (Loc, Chars (Typ));
 
-                  if Is_Immediately_Visible (Scope (Typ)) then
+                  if Is_Immediately_Visible (Scope (Typ))
+                    and then Current_Entity (Scope (Typ)) = Scope (Typ)
+                  then
                      Nam :=
                        Make_Selected_Component (Loc,
                          Prefix        =>
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 803ff81..2d9caca 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -2666,6 +2666,16 @@ package body Sem_Ch3 is
                   Freeze_From := Last_Entity (Current_Scope);
 
                else
+                  --  For declarations in a subprogram body there is no issue
+                  --  with name resolution in aspect specifications, but in
+                  --  ASIS mode we need to preanalyze aspect specifications
+                  --  that may otherwise only be analyzed during expansion
+                  --  (e.g. during generation of a related subprogram).
+
+                  if ASIS_Mode then
+                     Resolve_Aspects;
+                  end if;
+
                   Freeze_All (First_Entity (Current_Scope), Decl);
                   Freeze_From := Last_Entity (Current_Scope);
                end if;
@@ -13510,6 +13520,7 @@ package body Sem_Ch3 is
          end if;
 
          Constrain_Discriminated_Type (Def_Id, SI, Related_Nod);
+         Set_First_Private_Entity (Def_Id, First_Private_Entity (T_Ent));
 
          Set_Depends_On_Private (Def_Id, Has_Private_Component (Def_Id));
          Set_Corresponding_Record_Type (Def_Id,
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 01f5f5e..555217c 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -8554,14 +8554,21 @@ package body Sem_Ch4 is
                  ("expect variable in call to&", Prefix (N), Entity (Subprog));
             end if;
 
-         --  Conversely, if the formal is an access parameter and the object
-         --  is not, replace the actual with a 'Access reference. Its analysis
-         --  will check that the object is aliased.
+         --  Conversely, if the formal is an access parameter and the object is
+         --  not an access type or a reference type (i.e. a type with the
+         --  Implicit_Dereference aspect specified), replace the actual with a
+         --  'Access reference. Its analysis will check that the object is
+         --  aliased.
 
          elsif Is_Access_Type (Formal_Type)
            and then not Is_Access_Type (Etype (Obj))
+           and then (not Has_Implicit_Dereference (Etype (Obj))
+             or else
+               not Is_Access_Type
+                     (Designated_Type
+                        (Etype (Get_Reference_Discriminant (Etype (Obj))))))
          then
-            --  A special case: A.all'access is illegal if A is an access to a
+            --  A special case: A.all'Access is illegal if A is an access to a
             --  constant and the context requires an access to a variable.
 
             if not Is_Access_Constant (Formal_Type) then
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 5ca3584..468c112 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2882,6 +2882,11 @@ package body Sem_Ch6 is
                                New_Copy_Tree (Specification (N)));
 
                begin
+                  --  Link the body and the generated spec
+
+                  Set_Corresponding_Body (Decl, Body_Id);
+                  Set_Corresponding_Spec (N, Subp);
+
                   Set_Defining_Unit_Name (Specification (Decl), Subp);
 
                   --  To ensure proper coverage when body is inlined, indicate
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 69338d4..417de92 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -9097,14 +9097,9 @@ package body Sem_Prag is
          --  The entity of the first Ghost subprogram encountered while
          --  processing the arguments of the pragma.
 
-         procedure Make_Inline (Subp : Entity_Id);
-         --  Subp is the defining unit name of the subprogram declaration. If
-         --  the pragma is valid, call Set_Inline_Flags on Subp, as well as on
-         --  the corresponding body, if there is one present.
-
-         procedure Set_Inline_Flags (Subp : Entity_Id);
-         --  Set Has_Pragma_{No_Inline,Inline,Inline_Always} flag on Subp.
-         --  Also set or clear Is_Inlined flag on Subp depending on Status.
+         procedure Check_Inline_Always_Placement (Spec_Id : Entity_Id);
+         --  Verify the placement of pragma Inline_Always with respect to the
+         --  initial declaration of subprogram Spec_Id.
 
          function Inlining_Not_Possible (Subp : Entity_Id) return Boolean;
          --  Returns True if it can be determined at this stage that inlining
@@ -9116,6 +9111,222 @@ package body Sem_Prag is
          --  ??? is business with link symbols still valid, or does it relate
          --  to front end ZCX which is being phased out ???
 
+         procedure Make_Inline (Subp : Entity_Id);
+         --  Subp is the defining unit name of the subprogram declaration. If
+         --  the pragma is valid, call Set_Inline_Flags on Subp, as well as on
+         --  the corresponding body, if there is one present.
+
+         procedure Set_Inline_Flags (Subp : Entity_Id);
+         --  Set Has_Pragma_{No_Inline,Inline,Inline_Always} flag on Subp.
+         --  Also set or clear Is_Inlined flag on Subp depending on Status.
+
+         -----------------------------------
+         -- Check_Inline_Always_Placement --
+         -----------------------------------
+
+         procedure Check_Inline_Always_Placement (Spec_Id : Entity_Id) is
+            Spec_Decl : constant Node_Id := Unit_Declaration_Node (Spec_Id);
+
+            function Compilation_Unit_OK return Boolean;
+            pragma Inline (Compilation_Unit_OK);
+            --  Determine whether pragma Inline_Always applies to a compatible
+            --  compilation unit denoted by Spec_Id.
+
+            function Declarative_List_OK return Boolean;
+            pragma Inline (Declarative_List_OK);
+            --  Determine whether the initial declaration of subprogram Spec_Id
+            --  and the pragma appear in compatible declarative lists.
+
+            function Subprogram_Body_OK return Boolean;
+            pragma Inline (Subprogram_Body_OK);
+            --  Determine whether pragma Inline_Always applies to a compatible
+            --  subprogram body denoted by Spec_Id.
+
+            -------------------------
+            -- Compilation_Unit_OK --
+            -------------------------
+
+            function Compilation_Unit_OK return Boolean is
+               Comp_Unit : constant Node_Id := Parent (Spec_Decl);
+
+            begin
+               --  The pragma appears after the initial declaration of a
+               --  compilation unit.
+
+               --    procedure Comp_Unit;
+               --    pragma Inline_Always (Comp_Unit);
+
+               --  Note that for compatibility reasons, the following case is
+               --  also accepted.
+
+               --    procedure Stand_Alone_Body_Comp_Unit is
+               --       ...
+               --    end Stand_Alone_Body_Comp_Unit;
+               --    pragma Inline_Always (Stand_Alone_Body_Comp_Unit);
+
+               return
+                 Nkind (Comp_Unit) = N_Compilation_Unit
+                   and then Present (Aux_Decls_Node (Comp_Unit))
+                   and then Is_List_Member (N)
+                   and then List_Containing (N) =
+                              Pragmas_After (Aux_Decls_Node (Comp_Unit));
+            end Compilation_Unit_OK;
+
+            -------------------------
+            -- Declarative_List_OK --
+            -------------------------
+
+            function Declarative_List_OK return Boolean is
+               Context : constant Node_Id := Parent (Spec_Decl);
+
+               Init_Decl : Node_Id;
+               Init_List : List_Id;
+               Prag_List : List_Id;
+
+            begin
+               --  Determine the proper initial declaration. In general this is
+               --  the declaration node of the subprogram except when the input
+               --  denotes a generic instantiation.
+
+               --    procedure Inst is new Gen;
+               --    pragma Inline_Always (Inst);
+
+               --  In this case the original subprogram is moved inside an
+               --  anonymous package while pragma Inline_Always remains at the
+               --  level of the anonymous package. Use the declaration of the
+               --  package because it reflects the placement of the original
+               --  instantiation.
+
+               --    package Anon_Pack is
+               --       procedure Inst is ... end Inst;  --  original
+               --    end Anon_Pack;
+
+               --    procedure Inst renames Anon_Pack.Inst;
+               --    pragma Inline_Always (Inst);
+
+               if Is_Generic_Instance (Spec_Id) then
+                  Init_Decl := Parent (Parent (Spec_Decl));
+                  pragma Assert (Nkind (Init_Decl) = N_Package_Declaration);
+               else
+                  Init_Decl := Spec_Decl;
+               end if;
+
+               if Is_List_Member (Init_Decl) and then Is_List_Member (N) then
+                  Init_List := List_Containing (Init_Decl);
+                  Prag_List := List_Containing (N);
+
+                  --  The pragma and then initial declaration appear within the
+                  --  same declarative list.
+
+                  if Init_List = Prag_List then
+                     return True;
+
+                  --  A special case of the above is when both the pragma and
+                  --  the initial declaration appear in different lists of a
+                  --  package spec, protected definition, or a task definition.
+
+                  --    package Pack is
+                  --       procedure Proc;
+                  --    private
+                  --       pragma Inline_Always (Proc);
+                  --    end Pack;
+
+                  elsif Nkind_In (Context, N_Package_Specification,
+                                           N_Protected_Definition,
+                                           N_Task_Definition)
+                    and then Init_List = Visible_Declarations (Context)
+                    and then Prag_List = Private_Declarations (Context)
+                  then
+                     return True;
+                  end if;
+               end if;
+
+               return False;
+            end Declarative_List_OK;
+
+            ------------------------
+            -- Subprogram_Body_OK --
+            ------------------------
+
+            function Subprogram_Body_OK return Boolean is
+               Body_Decl : Node_Id;
+
+            begin
+               --  The pragma appears within the declarative list of a stand-
+               --  alone subprogram body.
+
+               --    procedure Stand_Alone_Body is
+               --       pragma Inline_Always (Stand_Alone_Body);
+               --    begin
+               --       ...
+               --    end Stand_Alone_Body;
+
+               --  The compiler creates a dummy spec in this case, however the
+               --  pragma remains within the declarative list of the body.
+
+               if Nkind (Spec_Decl) = N_Subprogram_Declaration
+                 and then not Comes_From_Source (Spec_Decl)
+                 and then Present (Corresponding_Body (Spec_Decl))
+               then
+                  Body_Decl :=
+                    Unit_Declaration_Node (Corresponding_Body (Spec_Decl));
+
+                  if Present (Declarations (Body_Decl))
+                    and then Is_List_Member (N)
+                    and then List_Containing (N) = Declarations (Body_Decl)
+                  then
+                     return True;
+                  end if;
+               end if;
+
+               return False;
+            end Subprogram_Body_OK;
+
+         --  Start of processing for Check_Inline_Always_Placement
+
+         begin
+            --  This check is relevant only for pragma Inline_Always
+
+            if Pname /= Name_Inline_Always then
+               return;
+
+            --  Nothing to do when the pragma is internally generated on the
+            --  assumption that it is properly placed.
+
+            elsif not Comes_From_Source (N) then
+               return;
+
+            --  Nothing to do for internally generated subprograms that act
+            --  as accidental homonyms of a source subprogram being inlined.
+
+            elsif not Comes_From_Source (Spec_Id) then
+               return;
+
+            --  Nothing to do for generic formal subprograms that act as
+            --  homonyms of another source subprogram being inlined.
+
+            elsif Is_Formal_Subprogram (Spec_Id) then
+               return;
+
+            elsif Compilation_Unit_OK
+              or else Declarative_List_OK
+              or else Subprogram_Body_OK
+            then
+               return;
+            end if;
+
+            --  At this point it is known that the pragma applies to or appears
+            --  within a completing body, a completing stub, or a subunit.
+
+            Error_Msg_Name_1 := Pname;
+            Error_Msg_Name_2 := Chars (Spec_Id);
+            Error_Msg_Sloc   := Sloc (Spec_Id);
+
+            Error_Msg_N
+              ("pragma % must appear on initial declaration of subprogram "
+               & "% defined #", N);
+         end Check_Inline_Always_Placement;
+
          ---------------------------
          -- Inlining_Not_Possible --
          ---------------------------
@@ -9236,6 +9447,12 @@ package body Sem_Prag is
             --  retrieve it as the alias of the visible subprogram instance.
 
             if Is_Subprogram (Subp) then
+
+               --  Ensure that pragma Inline_Always is associated with the
+               --  initial declaration of the subprogram.
+
+               Check_Inline_Always_Placement (Subp);
+
                if Is_Wrapper_Package (Scope (Subp)) then
                   Inner_Subp := Subp;
                else
@@ -13662,8 +13879,8 @@ package body Sem_Prag is
          --    related subprogram [body] when it is:
 
          --       aspect on subprogram declaration
-         --       aspect on stand alone subprogram body
-         --       pragma on stand alone subprogram body
+         --       aspect on stand-alone subprogram body
+         --       pragma on stand-alone subprogram body
 
          --    The annotation must prepare its own template when it is:
 
@@ -14523,8 +14740,8 @@ package body Sem_Prag is
          --    related subprogram [body] when it is:
 
          --       aspect on subprogram declaration
-         --       aspect on stand alone subprogram body
-         --       pragma on stand alone subprogram body
+         --       aspect on stand-alone subprogram body
+         --       pragma on stand-alone subprogram body
 
          --    The annotation must prepare its own template when it is:
 
@@ -15463,8 +15680,8 @@ package body Sem_Prag is
          --    related subprogram [body] when it is:
 
          --       aspect on subprogram declaration
-         --       aspect on stand alone subprogram body
-         --       pragma on stand alone subprogram body
+         --       aspect on stand-alone subprogram body
+         --       pragma on stand-alone subprogram body
 
          --    The annotation must prepare its own template when it is:
 
@@ -15906,7 +16123,7 @@ package body Sem_Prag is
                then
                   Id := Defining_Entity (Context);
 
-               --  Pragma Ghost applies to a stand alone subprogram body
+               --  Pragma Ghost applies to a stand-alone subprogram body
 
                elsif Nkind (Context) = N_Subprogram_Body
                  and then No (Corresponding_Spec (Context))
@@ -16050,8 +16267,8 @@ package body Sem_Prag is
          --    related subprogram [body] when it is:
 
          --       aspect on subprogram declaration
-         --       aspect on stand alone subprogram body
-         --       pragma on stand alone subprogram body
+         --       aspect on stand-alone subprogram body
+         --       pragma on stand-alone subprogram body
 
          --    The annotation must prepare its own template when it is:
 
@@ -19828,8 +20045,8 @@ package body Sem_Prag is
          --    related subprogram [body] when it is:
 
          --       aspect on subprogram declaration
-         --       aspect on stand alone subprogram body
-         --       pragma on stand alone subprogram body
+         --       aspect on stand-alone subprogram body
+         --       pragma on stand-alone subprogram body
 
          --    The annotation must prepare its own template when it is:
 
@@ -19875,8 +20092,8 @@ package body Sem_Prag is
          --    related subprogram [body] when it is:
 
          --       aspect on subprogram declaration
-         --       aspect on stand alone subprogram body
-         --       pragma on stand alone subprogram body
+         --       aspect on stand-alone subprogram body
+         --       pragma on stand-alone subprogram body
 
          --    The annotation must prepare its own template when it is:
 
@@ -21859,7 +22076,7 @@ package body Sem_Prag is
 
                if Nkind_In (Decl, N_Entry_Body, N_Subprogram_Body) then
 
-                  --  A stand alone subprogram body
+                  --  A stand-alone subprogram body
 
                   if Body_Id = Spec_Id then
                      Check_Pragma_Conformance
@@ -28644,7 +28861,7 @@ package body Sem_Prag is
          Depends := Get_Pragma (Subp_Id, Pragma_Refined_Depends);
          Global  := Get_Pragma (Subp_Id, Pragma_Refined_Global);
 
-      --  Subprogram declaration or stand alone body case, look for pragmas
+      --  Subprogram declaration or stand-alone body case, look for pragmas
       --  Depends and Global
 
       else
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 69819ed..0b73112 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -22049,14 +22049,14 @@ package body Sem_Util is
          end if;
       end if;
 
-      --  If E is an object or component, and the type of E is an anonymous
-      --  access type with no convention set, then also set the convention of
-      --  the anonymous access type. We do not do this for anonymous protected
-      --  types, since protected types always have the default convention.
+      --  If E is an object, including a component, and the type of E is an
+      --  anonymous access type with no convention set, then also set the
+      --  convention of the anonymous access type. We do not do this for
+      --  anonymous protected types, since protected types always have the
+      --  default convention.
 
       if Present (Etype (E))
         and then (Is_Object (E)
-                   or else Ekind (E) = E_Component
 
                    --  Allow E_Void (happens for pragma Convention appearing
                    --  in the middle of a record applying to a component)
@@ -22075,15 +22075,13 @@ package body Sem_Util is
                Set_Has_Convention_Pragma (Typ);
 
                --  And for the access subprogram type, deal similarly with the
-               --  designated E_Subprogram_Type if it is also internal (which
-               --  it always is?)
+               --  designated E_Subprogram_Type, which is always internal.
 
                if Ekind (Typ) = E_Anonymous_Access_Subprogram_Type then
                   declare
                      Dtype : constant Entity_Id := Designated_Type (Typ);
                   begin
                      if Ekind (Dtype) = E_Subprogram_Type
-                       and then Is_Itype (Dtype)
                        and then not Has_Convention_Pragma (Dtype)
                      then
                         Basic_Set_Convention (Dtype, Val);
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 5049ad6..30c35cb 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1056,7 +1056,7 @@ package Sem_Util is
      (Typ : Entity_Id;
       Nam : Name_Id) return Entity_Id;
    --  Retrieve one of the primitives First, Next, Has_Element, Element from
-   --  the value of the Iterable aspect of a formal type.
+   --  the value of the Iterable aspect of a type.
 
    procedure Get_Library_Unit_Name_String (Decl_Node : Node_Id);
    --  Retrieve the fully expanded name of the library unit declared by
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index 400ac42..4a902e8 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -2464,14 +2464,6 @@ package body Sinfo is
       return Flag17 (N);
    end No_Truncation;
 
-   function Non_Aliased_Prefix
-     (N : Node_Id) return Boolean is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Attribute_Reference);
-      return Flag18 (N);
-   end Non_Aliased_Prefix;
-
    function Null_Excluding_Subtype
       (N : Node_Id) return Boolean is
    begin
@@ -5774,14 +5766,6 @@ package body Sinfo is
       Set_Flag17 (N, Val);
    end Set_No_Truncation;
 
-   procedure Set_Non_Aliased_Prefix
-     (N : Node_Id; Val : Boolean := True) is
-   begin
-      pragma Assert (False
-        or else NT (N).Nkind = N_Attribute_Reference);
-      Set_Flag18 (N, Val);
-   end Set_Non_Aliased_Prefix;
-
    procedure Set_Null_Excluding_Subtype
       (N : Node_Id; Val : Boolean := True) is
    begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 0aef4b6..a5a6413 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -2083,13 +2083,6 @@ package Sinfo is
    --    is used for properly setting out of range values for use by pragmas
    --    Initialize_Scalars and Normalize_Scalars.
 
-   --  Non_Aliased_Prefix (Flag18-Sem)
-   --    Present in N_Attribute_Reference nodes. Set only for the case of an
-   --    Unrestricted_Access reference whose prefix is non-aliased, which is
-   --    the case that is permitted for Unrestricted_Access except when the
-   --    expected type is a thin pointer to unconstrained array. This flag is
-   --    to assist in detecting this illegal use of Unrestricted_Access.
-
    --  Null_Excluding_Subtype (Flag16)
    --    Present in N_Access_To_Object_Definition. Indicates that the subtype
    --    indication carries a null-exclusion indicator, which is distinct from
@@ -3944,7 +3937,6 @@ package Sinfo is
       --  Do_Overflow_Check (Flag17-Sem)
       --  Header_Size_Added (Flag11-Sem)
       --  Must_Be_Byte_Aligned (Flag14-Sem)
-      --  Non_Aliased_Prefix (Flag18-Sem)
       --  Redundant_Use (Flag13-Sem)
       --  plus fields for expression
 
@@ -9732,9 +9724,6 @@ package Sinfo is
    function No_Truncation
      (N : Node_Id) return Boolean;    -- Flag17
 
-   function Non_Aliased_Prefix
-     (N : Node_Id) return Boolean;    -- Flag18
-
    function Null_Excluding_Subtype
      (N : Node_Id) return Boolean;    -- Flag16
 
@@ -10791,9 +10780,6 @@ package Sinfo is
    procedure Set_No_Truncation
      (N : Node_Id; Val : Boolean := True);    -- Flag17
 
-   procedure Set_Non_Aliased_Prefix
-     (N : Node_Id; Val : Boolean := True);    -- Flag18
-
    procedure Set_Null_Excluding_Subtype
      (N : Node_Id; Val : Boolean := True);    -- Flag16
 
@@ -13129,7 +13115,6 @@ package Sinfo is
    pragma Inline (No_Minimize_Eliminate);
    pragma Inline (No_Side_Effect_Removal);
    pragma Inline (No_Truncation);
-   pragma Inline (Non_Aliased_Prefix);
    pragma Inline (Null_Excluding_Subtype);
    pragma Inline (Null_Exclusion_Present);
    pragma Inline (Null_Exclusion_In_Return_Present);
@@ -13478,7 +13463,6 @@ package Sinfo is
    pragma Inline (Set_No_Minimize_Eliminate);
    pragma Inline (Set_No_Side_Effect_Removal);
    pragma Inline (Set_No_Truncation);
-   pragma Inline (Set_Non_Aliased_Prefix);
    pragma Inline (Set_Null_Excluding_Subtype);
    pragma Inline (Set_Null_Exclusion_Present);
    pragma Inline (Set_Null_Exclusion_In_Return_Present);
diff --git a/gcc/ada/treepr.ads b/gcc/ada/treepr.ads
index 6ba58d6..c49d5e5 100644
--- a/gcc/ada/treepr.ads
+++ b/gcc/ada/treepr.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -49,7 +49,7 @@ package Treepr is
    --  of the nodes in the list
 
    procedure Print_Node_Subtree (N : Node_Id);
-   --  Prints the subtree routed at a specified tree node, including all
+   --  Prints the subtree rooted at a specified tree node, including all
    --  referenced descendants.
 
    procedure Print_List_Subtree (L : List_Id);
diff --git a/gcc/ada/validsw.ads b/gcc/ada/validsw.ads
index db9ceb2..7ea1815 100644
--- a/gcc/ada/validsw.ads
+++ b/gcc/ada/validsw.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2001-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-2017, 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- --
@@ -54,7 +54,7 @@ package Validsw is
 
    Validity_Check_Default : Boolean := True;
    --  Controls default (reference manual) validity checking. If this switch is
-   --  set to True using -gnatVd or a 'd' in the argument of a Validity_ Checks
+   --  set to True using -gnatVd or a 'd' in the argument of a Validity_Checks
    --  pragma (or the initial default value is used, set True), then left side
    --  subscripts and case statement arguments are checked for validity. This
    --  switch is also set by default if no -gnatV switch is used and no
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d7e95dc..a844195 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,15 @@
+2017-09-18  Bob Duff  <duff@adacore.com>
+
+	* gnat.dg/validity_check.adb: New testcase.
+
+2017-09-18  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/overload.ads, gnat.dg/overload.adb: New testcase.
+
+2017-09-18  Bob Duff  <duff@adacore.com>
+
+	* gnat.dg/tagged_prefix_call.adb: New testcase.
+
 2017-09-18  Ed Schonberg  <schonberg@adacore.com>
 
 	* gnat.dg/default_variants.adb: New testcase.
diff --git a/gcc/testsuite/gnat.dg/overload.adb b/gcc/testsuite/gnat.dg/overload.adb
new file mode 100644
index 0000000..9e82815
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/overload.adb
@@ -0,0 +1,23 @@
+--  { dg-do compile }
+
+package body Overload is
+
+   function Get (I : Integer) return Ptr1 is
+      P : Ptr1 := null;
+   begin
+      return P;
+   end;
+
+   function Get (I : Integer) return Ptr2 is
+      P : Ptr2 := null;
+   begin
+      return P;
+   end;
+
+   function F (I : Integer) return Ptr1 is
+     P : Ptr1 := Get (I).Data'Access;
+   begin
+     return P;
+   end;
+
+end Overload;
diff --git a/gcc/testsuite/gnat.dg/overload.ads b/gcc/testsuite/gnat.dg/overload.ads
new file mode 100644
index 0000000..42ec679
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/overload.ads
@@ -0,0 +1,20 @@
+package Overload is
+
+   type Rec1 is record
+      Data : Integer;
+   end record;
+   type Ptr1 is access all Rec1;
+
+   type Rec2 is record
+      Data : aliased Rec1;
+   end record;
+
+   type Ptr2 is access Rec2;
+
+   function Get (I : Integer) return Ptr1;
+
+   function Get (I : Integer) return Ptr2;
+
+   function F (I : Integer) return Ptr1;
+     
+end Overload;
diff --git a/gcc/testsuite/gnat.dg/tagged_prefix_call.adb b/gcc/testsuite/gnat.dg/tagged_prefix_call.adb
new file mode 100644
index 0000000..15d1ba1
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/tagged_prefix_call.adb
@@ -0,0 +1,24 @@
+--  { dg-do compile }
+
+procedure Tagged_Prefix_Call is
+
+   package Defs is
+      type Database_Connection_Record is abstract tagged null record;
+      type Database_Connection is access all Database_Connection_Record'Class;
+
+      procedure Start_Transaction
+        (Self : not null access Database_Connection_Record'Class)
+      is null;
+
+      type DB_Connection (Elem : access Database_Connection)
+      is null record
+        with Implicit_Dereference => Elem;
+   end Defs;
+
+   use Defs;
+
+   DB  : DB_Connection(null);
+
+begin
+   DB.Start_Transaction;
+end Tagged_Prefix_Call;
diff --git a/gcc/testsuite/gnat.dg/validity_check.adb b/gcc/testsuite/gnat.dg/validity_check.adb
new file mode 100644
index 0000000..a37a595
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/validity_check.adb
@@ -0,0 +1,18 @@
+--  { dg-do run }
+--  { dg-options "-cargs -O -gnatn -gnatVa -gnatws -margs" }
+
+pragma Initialize_Scalars;
+
+procedure Validity_Check is
+
+   type Small_Int is mod 2**6;
+
+   type Arr is array (1 .. 16) of Small_Int;
+   pragma Pack (Arr);
+
+   S : Small_Int;
+   A : Arr;
+
+begin
+   null;
+end;