[multiple changes]

2012-04-26  Robert Dewar  <dewar@adacore.com>

	* einfo.adb, einfo.ads, sem_res.adb, sem_ch4.adb,
	sem_eval.adb: Minor reformatting.

2012-04-26  Thomas Quinot  <quinot@adacore.com>

	* freeze.adb: Minor change in error wording.

2012-04-26  Ed Schonberg  <schonberg@adacore.com>

	* gnat_ugn.texi: Documentation on dimensional analysis.

2012-04-26  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb, einfo.ads: Remove synthesized attribute
	Proper_First_Index along with its associations in various nodes.
	(Proper_First_Index): Removed.
	* sem_ch4.adb (Analyze_Slice): Alphabetize constants. Add new
	local variable Index_Type. The index type of a string literal
	subtype is that of the stored low bound.
	* sem_eval (Get_Static_Length): Remove the use of Proper_First_Index.
	* sem_res.adb (Resolve_Slice): Alphabetize constants. Add
	new local variable Index_Type. The index type of a
	string literal subtype is that of the stored low bound.
	(Set_String_Literal_Subtype): Code reformatting.

From-SVN: r186868

11 files changed, 244 insertions, 79 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 6a19fc7e..cf0cac6 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,32 @@
 2012-04-26  Robert Dewar  <dewar@adacore.com>
 
+	* einfo.adb, einfo.ads, sem_res.adb, sem_ch4.adb,
+	sem_eval.adb: Minor reformatting.
+
+2012-04-26  Thomas Quinot  <quinot@adacore.com>
+
+	* freeze.adb: Minor change in error wording.
+
+2012-04-26  Ed Schonberg  <schonberg@adacore.com>
+
+	* gnat_ugn.texi: Documentation on dimensional analysis.
+
+2012-04-26  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* einfo.adb, einfo.ads: Remove synthesized attribute
+	Proper_First_Index along with its associations in various nodes.
+	(Proper_First_Index): Removed.
+	* sem_ch4.adb (Analyze_Slice): Alphabetize constants. Add new
+	local variable Index_Type. The index type of a string literal
+	subtype is that of the stored low bound.
+	* sem_eval (Get_Static_Length): Remove the use of Proper_First_Index.
+	* sem_res.adb (Resolve_Slice): Alphabetize constants. Add
+	new local variable Index_Type. The index type of a
+	string literal subtype is that of the stored low bound.
+	(Set_String_Literal_Subtype): Code reformatting.
+
+2012-04-26  Robert Dewar  <dewar@adacore.com>
+
 	* exp_aggr.adb: Minor reformatting.
 
 2012-04-26  Hristian Kirtchev  <kirtchev@adacore.com>
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 46d8ace..0f597a1 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -6456,26 +6456,6 @@ package body Einfo is
                 and then Present (Prival_Link (Id)));
    end Is_Prival;
 
-   ------------------------
-   -- Proper_First_Index --
-   ------------------------
-
-   function Proper_First_Index (Id : E) return E is
-      Typ : Entity_Id;
-
-   begin
-      Typ := Id;
-
-      --  The First_Index field is always empty for string literals, use the
-      --  base type instead.
-
-      if Ekind (Typ) = E_String_Literal_Subtype then
-         Typ := Base_Type (Typ);
-      end if;
-
-      return First_Index (Typ);
-   end Proper_First_Index;
-
    ----------------------------
    -- Is_Protected_Component --
    ----------------------------
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 1badc88..d07be81 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -3393,11 +3393,6 @@ package Einfo is
 --       in the shadow entity, it points to the proper location in which to
 --       restore the private view saved in the shadow.
 
---    Proper_First_Index (synthesized)
---       Applies to array types and subtypes. Returns the First_Index of the
---       type unless it is a string literal. In that case, the First_Index is
---       obtained from the base type.
-
 --    Protected_Formal (Node22)
 --       Present in formal parameters (in, in out and out parameters). Used
 --       only for formals of protected operations. References corresponding
@@ -5031,7 +5026,6 @@ package Einfo is
    --    Is_Constrained                      (Flag12)
    --    Next_Index                          (synth)
    --    Number_Dimensions                   (synth)
-   --    Proper_First_Index                  (synth)
    --    (plus type attributes)
 
    --  E_Block
@@ -5694,7 +5688,6 @@ package Einfo is
    --    Is_Constrained                      (Flag12)
    --    Next_Index                          (synth)
    --    Number_Dimensions                   (synth)
-   --    Proper_First_Index                  (synth)
    --    (plus type attributes)
 
    --  E_String_Literal_Subtype
@@ -5702,7 +5695,6 @@ package Einfo is
    --    String_Literal_Length               (Uint16)
    --    First_Index                         (Node17)   (always Empty)
    --    Packed_Array_Type                   (Node23)
-   --    Proper_First_Index                  (synth)
    --    (plus type attributes)
 
    --  E_Subprogram_Body
@@ -6540,7 +6532,6 @@ package Einfo is
    function Number_Formals                      (Id : E) return Pos;
    function Parameter_Mode                      (Id : E) return Formal_Kind;
    function Primitive_Operations                (Id : E) return L;
-   function Proper_First_Index                  (Id : E) return E;
    function Root_Type                           (Id : E) return E;
    function Safe_Emax_Value                     (Id : E) return U;
    function Safe_First_Value                    (Id : E) return R;
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 8d51701..3091080 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -157,9 +157,9 @@ package body Exp_Util is
    --    1) controlled objects
    --    2) library-level tagged types
    --
-   --  Flag Lib_Level should be set when the list comes from a construct at
-   --  the library level. Flag Nested_Constructs should be set when any nested
-   --  packages declared in L must be processed.
+   --  Lib_Level is True when the list comes from a construct at the library
+   --  level, and False otherwise. Nested_Constructs is True when any nested
+   --  packages declared in L must be processed, and False otherwise.
 
    -------------------------------------
    -- Activate_Atomic_Synchronization --
@@ -7042,8 +7042,10 @@ package body Exp_Util is
      (N         : Node_Id;
       Lib_Level : Boolean) return Boolean
    is
-      At_Lib_Level : constant Boolean := Lib_Level and then
-                       Nkind_In (N, N_Package_Body, N_Package_Specification);
+      At_Lib_Level : constant Boolean :=
+                       Lib_Level
+                         and then Nkind_In (N, N_Package_Body,
+                                               N_Package_Specification);
       --  N is at the library level if the top-most context is a package and
       --  the path taken to reach N does not inlcude non-package constructs.
 
@@ -7059,10 +7061,11 @@ package body Exp_Util is
             return
               Requires_Cleanup_Actions (Declarations (N), At_Lib_Level, True)
                 or else
-              (Present (Handled_Statement_Sequence (N))
-                and then
-              Requires_Cleanup_Actions (Statements
-                (Handled_Statement_Sequence (N)), At_Lib_Level, True));
+                  (Present (Handled_Statement_Sequence (N))
+                    and then
+                      Requires_Cleanup_Actions
+                        (Statements (Handled_Statement_Sequence (N)),
+                         At_Lib_Level, True));
 
          when N_Package_Specification =>
             return
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index e42c8a5..e25d48e 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -753,8 +753,8 @@ package Exp_Util is
    --    1) controlled objects
    --    2) library-level tagged types
    --
-   --  The above cases require special actions on scope exit. Flag Lib_Level
-   --  is used to track whether a construct is at the library level.
+   --  These cases require special actions on scope exit. The flag Lib_Level
+   --  is set True if the construct is at library level, and False otherwise.
 
    function Safe_Unchecked_Type_Conversion (Exp : Node_Id) return Boolean;
    --  Given the node for an N_Unchecked_Type_Conversion, return True if this
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 5a7d3b2..a4588bd 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -2144,7 +2144,7 @@ package body Freeze is
             Error_Msg_Sloc := Sloc (ADC);
             Error_Msg_N
               ("scalar storage order for& specified# inconsistent with "
-               & "its bit order", Rec);
+               & "bit order", Rec);
          end if;
 
          --  Deal with Bit_Order aspect specifying a non-default bit order
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index e8e4d6e..57cb020 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -195,6 +195,7 @@ AdaCore@*
 * Verifying Properties Using gnatcheck::
 * Creating Sample Bodies Using gnatstub::
 * Creating Unit Tests Using gnattest::
+* Performing Dimensionality Analysis in GNAT::
 * Generating Ada Bindings for C and C++ headers::
 * Other Utility Programs::
 * Running and Debugging Ada Programs::
@@ -838,6 +839,12 @@ a utility that generates empty but compilable bodies for library units.
 a utility that generates unit testing templates for library units.
 
 @item
+@ref{Performing Dimensionality Analysis in GNAT}, describes the Ada 2012
+facilities used in GNAT to declare dimensioned objects, and to verify that
+uses of these objects are consistent with their given physical dimensions
+(so that meters cannot be assigned to kilograms, and so on).
+
+@item
 @ref{Generating Ada Bindings for C and C++ headers}, describes how to
 generate automatically Ada bindings from C and C++ headers.
 
@@ -18513,6 +18520,152 @@ The tool currently does not support following features:
 @end itemize
 
 @c *********************************
+@node Performing Dimensionality Analysis in GNAT
+@chapter Performing Dimensionality Analysis in GNAT
+@noindent
+The GNAT compiler now supports dimensionality checking. The user can
+specify physical units for objects, and the compiler will verify that uses
+of these objects are compatible with their dimensions, in a fashion that is
+familiar to engineering practice. The dimensions of algebraic expressions
+(including powers with static exponents) are computed from their consistuents.
+
+This feature depends on Ada 2012 aspect specifications, and is available from
+version 7.0.1 of GNAT onwards. The GNAT-specific aspect Dimension_System allows
+the user to define a system of units; the aspect Dimension then allows the user
+to declare dimensioned quantities within a given system.
+
+The simplest way to impose dimensionality checking on a computation is to make
+use of the package System.Dim.Mks, which is part of the GNAT library. This
+package defines a floating-point type MKS_Type, for which a sequence of
+dimension names are specified, together with their conventional abbreviations.
+The following should be read together with the full specification of the
+package, in file s-dimmks.ads.
+
+@smallexample @c ada
+   type Mks_Type is new Long_Long_Float
+     with
+      Dimension_System => (
+        (Meter,    'm'),
+        (Kilogram, "kg"),
+        (Second,   's'),
+        (Ampere,   'A'),
+        (Kelvin,   'K'),
+        (Mole,     "mol"),
+        (Candela,  "cd"));
+@end smallexample
+
+@noindent
+The package then defines a series of subtypes that correspond to these
+conventional units. For example:
+@smallexample @c ada
+   subtype Length is Mks_Type
+     with
+      Dimension => ('m',
+        Meter =>  1,
+        others => 0);
+@end smallexample
+@noindent
+and similarly for Mass, Time, Electric_Current, Thermodynamic_Temperature,
+Amount_Of_Substance, and Luminous_Intensity (the standard set of units of
+the SI system).
+
+The package also defines conventional names for values of each unit, for
+example:
+
+@smallexample @c ada
+   m   : constant Length                    := 1.0;
+   kg  : constant Mass                      := 1.0;
+   s   : constant Time                      := 1.0;
+   A   : constant Electric_Current          := 1.0;
+@end smallexample
+
+@noindent
+as well as useful multiples of these units:
+
+@smallexample @c ada
+   cm  : constant Length := 1.0E-02;
+   g   : constant Mass   := 1.0E-03;
+   min : constant Time   := 60.0;
+   day : constant TIme   := 60.0 * 24.0 * min;
+  ...
+@end smallexample
+
+@noindent
+The user can then define a derived unit by providing the aspect that
+specifies its dimensions within the MKS system:
+
+@smallexample @c ada
+  subtype Acceleration is Mks_Type
+    with Dimension => ("m/sec**2", 1, 0, -2, others => 0);
+@end smallexample
+
+@noindent
+Here is a complete example of use:
+
+@smallexample @c ada
+with System.Dim.MKS; use System.Dim.Mks;
+with System.Dim.Mks_IO; use System.Dim.Mks_IO;
+with Text_IO; use Text_IO;
+procedure Free_Fall is
+  subtype Acceleration is Mks_Type
+    with Dimension => ("m/sec**2", 1, 0, -2, others => 0);
+  G : constant acceleration := 9.81 * m / (s ** 2);
+  T : Time := 10.0*s;
+  Distance : Length;
+begin
+  Distance := 0.5 * G * T ** 2;
+  Put ("distance travelled in 10 seconds of free fall ");
+  Put (Distance, Aft => 2, Exp => 0);
+  Put_Line ("");
+end Free_Fall;
+@end smallexample
+
+@noindent
+Execution of this program yields:
+@smallexample
+distance travelled in 10 seconds of free fall 490.50 m
+@end smallexample
+
+@noindent
+However, incorrect assignments such as:
+
+@smallexample @c ada
+   Distance := 5.0;
+   Distance := 5.0 * kg:
+@end smallexample
+
+@noindent
+are rejected with the following diagnoses:
+
+@smallexample
+   Distance := 5.0;
+      >>> dimensions mismatch in assignment
+      >>> left-hand side has dimensions (1, 0, 0, 0, 0, 0, 0)
+      >>> right-hand side is dimensionless
+
+   Distance := 5.0 * kg:
+      >>> dimensions mismatch in assignment
+      >>> left-hand side has dimensions  (1, 0, 0, 0, 0, 0, 0)
+      >>> right-hand side has dimensions (0, 1, 0, 0, 0, 0, 0)
+@end smallexample
+
+@noindent
+The dimensions of an expression are properly displayed. If we add to the
+program:
+
+@smallexample @c ada
+      Put ("Final velocity: ");
+      Put (G * T, Aft =>2, Exp =>0);
+      Put_Line ("");
+@end smallexample
+
+@noindent
+then the output includes:
+@smallexample
+     Final velocity: 98.10 m.s**(-1)
+@end smallexample
+
+@c *********************************
 @node Generating Ada Bindings for C and C++ headers
 @chapter Generating Ada Bindings for C and C++ headers
 @findex binding
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 1084ee2..56866e4 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -1096,22 +1096,22 @@ package body Prj.Nmsc is
          Element  : Package_Element;
 
          procedure Process_Binder (Arrays : Array_Id);
-         --  Process the associate array attributes of package Binder
+         --  Process the associated array attributes of package Binder
 
          procedure Process_Builder (Attributes : Variable_Id);
          --  Process the simple attributes of package Builder
 
          procedure Process_Clean  (Arrays : Array_Id);
-         --  Process the associate array attributes of package Clean
+         --  Process the associated array attributes of package Clean
 
          procedure Process_Compiler (Arrays : Array_Id);
-         --  Process the associate array attributes of package Compiler
+         --  Process the associated array attributes of package Compiler
 
          procedure Process_Naming (Attributes : Variable_Id);
          --  Process the simple attributes of package Naming
 
          procedure Process_Naming (Arrays : Array_Id);
-         --  Process the associate array attributes of package Naming
+         --  Process the associated array attributes of package Naming
 
          procedure Process_Linker (Attributes : Variable_Id);
          --  Process the simple attributes of package Linker of a
@@ -1238,7 +1238,7 @@ package body Prj.Nmsc is
             List             : String_List_Id;
 
          begin
-            --  Process the associative array attribute of package Clean
+            --  Process the associated array attributes of package Clean
 
             Current_Array_Id := Arrays;
             while Current_Array_Id /= No_Array loop
@@ -1250,8 +1250,9 @@ package body Prj.Nmsc is
 
                   --  Get the name of the language
 
-                  Lang_Index := Get_Language_From_Name
-                    (Project, Get_Name_String (Element.Index));
+                  Lang_Index :=
+                    Get_Language_From_Name
+                      (Project, Get_Name_String (Element.Index));
 
                   if Lang_Index /= No_Language_Index then
                      case Current_Array.Name is
@@ -1279,6 +1280,7 @@ package body Prj.Nmsc is
                                    From_List => List,
                                    In_Tree   => Data.Tree);
                            end if;
+
                         when others =>
                            null;
                      end case;
@@ -3291,8 +3293,8 @@ package body Prj.Nmsc is
       if Project.Library then
          Support_For_Libraries := Project.Config.Lib_Support;
 
-         if not Project.Externally_Built and then
-           Support_For_Libraries = Prj.None
+         if not Project.Externally_Built
+           and then Support_For_Libraries = Prj.None
          then
             Error_Msg
               (Data.Flags,
@@ -3481,8 +3483,8 @@ package body Prj.Nmsc is
                   end if;
 
                   if Project.Library_Kind /= Static then
-                     if not Project.Externally_Built and then
-                       Support_For_Libraries = Prj.Static_Only
+                     if not Project.Externally_Built
+                       and then Support_For_Libraries = Prj.Static_Only
                      then
                         Error_Msg
                           (Data.Flags,
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index d6c12b6..c1e386e 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -4440,9 +4440,10 @@ package body Sem_Ch4 is
    -------------------
 
    procedure Analyze_Slice (N : Node_Id) is
-      P          : constant Node_Id := Prefix (N);
       D          : constant Node_Id := Discrete_Range (N);
+      P          : constant Node_Id := Prefix (N);
       Array_Type : Entity_Id;
+      Index_Type : Entity_Id;
 
       procedure Analyze_Overloaded_Slice;
       --  If the prefix is overloaded, select those interpretations that
@@ -4513,13 +4514,18 @@ package body Sem_Ch4 is
             Error_Msg_N
               ("type is not one-dimensional array in slice prefix", N);
 
-         elsif not
-           Has_Compatible_Type (D, Etype (Proper_First_Index (Array_Type)))
-         then
-            Wrong_Type (D, Etype (Proper_First_Index (Array_Type)));
-
          else
-            Set_Etype (N, Array_Type);
+            if Ekind (Array_Type) = E_String_Literal_Subtype then
+               Index_Type := Etype (String_Literal_Low_Bound (Array_Type));
+            else
+               Index_Type := Etype (First_Index (Array_Type));
+            end if;
+
+            if not Has_Compatible_Type (D, Index_Type) then
+               Wrong_Type (D, Index_Type);
+            else
+               Set_Etype (N, Array_Type);
+            end if;
          end if;
       end if;
    end Analyze_Slice;
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 6cd0458..27a0f62 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -554,7 +554,7 @@ package body Sem_Eval is
                if Attribute_Name (N) = Name_First then
                   return String_Literal_Low_Bound (Xtyp);
 
-               else         -- Attribute_Name (N) = Name_Last
+               else
                   return Make_Integer_Literal (Sloc (N),
                     Intval => Intval (String_Literal_Low_Bound (Xtyp))
                                 + String_Literal_Length (Xtyp));
@@ -2747,7 +2747,7 @@ package body Sem_Eval is
 
                --  General case
 
-               T := Etype (Proper_First_Index (Etype (Op)));
+               T := Etype (First_Index (Etype (Op)));
 
                --  The simple case, both bounds are known at compile time
 
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 43e1255..5a3c6a4 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -8880,10 +8880,10 @@ package body Sem_Res is
    -------------------
 
    procedure Resolve_Slice (N : Node_Id; Typ : Entity_Id) is
-      Name       : constant Node_Id := Prefix (N);
       Drange     : constant Node_Id := Discrete_Range (N);
+      Name       : constant Node_Id := Prefix (N);
       Array_Type : Entity_Id        := Empty;
-      Index      : Node_Id;
+      Index_Type : Entity_Id;
 
    begin
       if Is_Overloaded (Name) then
@@ -9003,8 +9003,13 @@ package body Sem_Res is
       --  necessary. Else resolve the bounds, and apply needed checks.
 
       if not Is_Entity_Name (Drange) then
-         Index := Proper_First_Index (Array_Type);
-         Resolve (Drange, Base_Type (Etype (Index)));
+         if Ekind (Array_Type) = E_String_Literal_Subtype then
+            Index_Type := Etype (String_Literal_Low_Bound (Array_Type));
+         else
+            Index_Type := Etype (First_Index (Array_Type));
+         end if;
+
+         Resolve (Drange, Base_Type (Index_Type));
 
          if Nkind (Drange) = N_Range then
 
@@ -9026,7 +9031,7 @@ package body Sem_Res is
                   and then Entity (Selector_Name (Prefix (N))) =
                                          RTE_Record_Component (RE_Prims_Ptr))
             then
-               Apply_Range_Check (Drange, Etype (Index));
+               Apply_Range_Check (Drange, Index_Type);
             end if;
          end if;
       end if;
@@ -10119,26 +10124,24 @@ package body Sem_Res is
       Set_Is_Constrained (Subtype_Id);
       Set_Etype          (N, Subtype_Id);
 
-      if Is_OK_Static_Expression (Low_Bound) then
-
       --  The low bound is set from the low bound of the corresponding index
       --  type. Note that we do not store the high bound in the string literal
       --  subtype, but it can be deduced if necessary from the length and the
       --  low bound.
 
+      if Is_OK_Static_Expression (Low_Bound) then
          Set_String_Literal_Low_Bound (Subtype_Id, Low_Bound);
 
-      else
-         --  If the lower bound is not static we create a range for the string
-         --  literal, using the index type and the known length of the literal.
-         --  The index type is not necessarily Positive, so the upper bound is
-         --  computed as  T'Val (T'Pos (Low_Bound) + L - 1)
+      --  If the lower bound is not static we create a range for the string
+      --  literal, using the index type and the known length of the literal.
+      --  The index type is not necessarily Positive, so the upper bound is
+      --  computed as T'Val (T'Pos (Low_Bound) + L - 1).
 
+      else
          declare
-            Index_List    : constant List_Id    := New_List;
-            Index_Type    : constant Entity_Id := Etype (First_Index (Typ));
-
-            High_Bound : constant Node_Id :=
+            Index_List : constant List_Id   := New_List;
+            Index_Type : constant Entity_Id := Etype (First_Index (Typ));
+            High_Bound : constant Node_Id   :=
                            Make_Attribute_Reference (Loc,
                              Attribute_Name => Name_Val,
                              Prefix         =>
@@ -10157,9 +10160,9 @@ package body Sem_Res is
                                      String_Length (Strval (N)) - 1))));
 
             Array_Subtype : Entity_Id;
-            Index_Subtype : Entity_Id;
             Drange        : Node_Id;
             Index         : Node_Id;
+            Index_Subtype : Entity_Id;
 
          begin
             if Is_Integer_Type (Index_Type) then
@@ -10214,7 +10217,7 @@ package body Sem_Res is
             Rewrite (N,
               Make_Unchecked_Type_Conversion (Loc,
                 Subtype_Mark => New_Occurrence_Of (Array_Subtype, Loc),
-                Expression => Relocate_Node (N)));
+                Expression   => Relocate_Node (N)));
             Set_Etype (N, Array_Subtype);
          end;
       end if;