[multiple changes]

2015-11-12  Gary Dismukes  <dismukes@adacore.com>

	* gnat1drv.adb, opt.ads: Minor reformatting.

2015-11-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Analyze_Number_Declaration): Call Analyze_Dimension,
	to propagate dimension information from expression to named
	number.
	* sem_dim.ads: Documentation:  number declaration and explicit
	dereference can carry dimension information.
	* sem_dim.adb (Analyze_Dimension_Number_Declaration): New
	procedure, to propagate dimension information from expression
	of declaration to named number, whose type becomes one of the
	dimensioned base types rather than universal real.
	(Analyze_Dimension_Binary_Op):
	a) If one operand is a literal that is the value of a declared
	constant after constant-foloding, use the dimensions of the
	declared constant.
	b) If an operand is a literal that is a contant-folded expression,
	and expander is active, do not report a dimension mismatch if
	literal does not carry them, because dimension matching will
	have been checked previously.

From-SVN: r230244

1 files changed, 74 insertions, 8 deletions

diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb
index 1706f5e..7a544b6 100644
--- a/gcc/ada/sem_dim.adb
+++ b/gcc/ada/sem_dim.adb
@@ -253,6 +253,11 @@ package body Sem_Dim is
    --    N_Type_Conversion
    --    N_Unchecked_Type_Conversion
 
+   procedure Analyze_Dimension_Number_Declaration (N : Node_Id);
+   --  Procedure to analyze dimension of expression in a number declaration.
+   --  This allows a named number to have non-trivial dimensions, while by
+   --  default a named number is dimensionless.
+
    procedure Analyze_Dimension_Object_Declaration (N : Node_Id);
    --  Subroutine of Analyze_Dimension for object declaration. Check that
    --  the dimensions of the object type and the dimensions of the expression
@@ -1147,6 +1152,9 @@ package body Sem_Dim is
               N_Unchecked_Type_Conversion =>
             Analyze_Dimension_Has_Etype (N);
 
+         when N_Number_Declaration =>
+            Analyze_Dimension_Number_Declaration (N);
+
          when N_Object_Declaration =>
             Analyze_Dimension_Object_Declaration (N);
 
@@ -1308,10 +1316,30 @@ package body Sem_Dim is
    procedure Analyze_Dimension_Binary_Op (N : Node_Id) is
       N_Kind : constant Node_Kind := Nkind (N);
 
+      function Dimensions_Of_Operand (N : Node_Id) return Dimension_Type;
+      --  If the operand is a numeric literal that comes from a declared
+      --  constant, use the dimensions of the constant which were computed
+      --  from the expression of the constant declaration.
+
       procedure Error_Dim_Msg_For_Binary_Op (N, L, R : Node_Id);
       --  Error using Error_Msg_NE and Error_Msg_N at node N. Output the
       --  dimensions of both operands.
 
+      ---------------------------
+      -- Dimensions_Of_Operand --
+      ---------------------------
+
+      function Dimensions_Of_Operand (N : Node_Id) return Dimension_Type is
+      begin
+         if Nkind (N) = N_Real_Literal
+           and then Present (Original_Entity (N))
+         then
+            return Dimensions_Of (Original_Entity (N));
+         else
+            return Dimensions_Of (N);
+         end if;
+      end Dimensions_Of_Operand;
+
       ---------------------------------
       -- Error_Dim_Msg_For_Binary_Op --
       ---------------------------------
@@ -1334,10 +1362,12 @@ package body Sem_Dim is
       then
          declare
             L                : constant Node_Id        := Left_Opnd (N);
-            Dims_Of_L        : constant Dimension_Type := Dimensions_Of (L);
+            Dims_Of_L        : constant Dimension_Type :=
+                                 Dimensions_Of_Operand (L);
             L_Has_Dimensions : constant Boolean        := Exists (Dims_Of_L);
             R                : constant Node_Id        := Right_Opnd (N);
-            Dims_Of_R        : constant Dimension_Type := Dimensions_Of (R);
+            Dims_Of_R        : constant Dimension_Type :=
+                                 Dimensions_Of_Operand (R);
             R_Has_Dimensions : constant Boolean        := Exists (Dims_Of_R);
             Dims_Of_N        : Dimension_Type          := Null_Dimension;
 
@@ -1453,20 +1483,40 @@ package body Sem_Dim is
             --  Comparison cases
 
             --  For relational operations, only dimension checking is
-            --  performed (no propagation).
+            --  performed (no propagation). If one operand is the result
+            --  of constant folding the dimensions may have been lost
+            --  in a tree copy, so assume that pre-analysis has verified
+            --  that dimensions are correct.
 
             elsif N_Kind in N_Op_Compare then
                if (L_Has_Dimensions or R_Has_Dimensions)
                  and then Dims_Of_L /= Dims_Of_R
                then
-                  Error_Dim_Msg_For_Binary_Op (N, L, R);
+                  if Nkind (L) = N_Real_Literal
+                    and then not (Comes_From_Source (L))
+                    and then Expander_Active
+                  then
+                     null;
+
+                  elsif Nkind (R) = N_Real_Literal
+                    and then not (Comes_From_Source (R))
+                    and then Expander_Active
+                  then
+                     null;
+
+                  else
+                     Error_Dim_Msg_For_Binary_Op (N, L, R);
+                  end if;
                end if;
             end if;
 
-            --  Removal of dimensions for each operands
+            --  If  expander is active, remove dimension information from each
+            --  operand, as only dimensions of result are relevant.
 
-            Remove_Dimensions (L);
-            Remove_Dimensions (R);
+            if Expander_Active then
+               Remove_Dimensions (L);
+               Remove_Dimensions (R);
+            end if;
          end;
       end if;
    end Analyze_Dimension_Binary_Op;
@@ -1929,7 +1979,7 @@ package body Sem_Dim is
                Check_Error_Detected;
                return;
 
-            elsif Ekind (Id) = E_Constant
+            elsif Ekind_In (Id,  E_Constant, E_Named_Real)
               and then Exists (Dimensions_Of (Id))
             then
                Set_Dimensions (N, Dimensions_Of (Id));
@@ -1981,6 +2031,22 @@ package body Sem_Dim is
    end Analyze_Dimension_Has_Etype;
 
    ------------------------------------------
+   -- Analyze_Dimension_Number_Declaration --
+   ------------------------------------------
+
+   procedure Analyze_Dimension_Number_Declaration (N : Node_Id) is
+      Expr        : constant Node_Id        := Expression (N);
+      Id          : constant Entity_Id      := Defining_Identifier (N);
+      Dim_Of_Expr : constant Dimension_Type := Dimensions_Of (Expr);
+
+   begin
+      if Exists (Dim_Of_Expr) then
+         Set_Dimensions (Id, Dim_Of_Expr);
+         Set_Etype (Id, Etype (Expr));
+      end if;
+   end Analyze_Dimension_Number_Declaration;
+
+   ------------------------------------------
    -- Analyze_Dimension_Object_Declaration --
    ------------------------------------------