[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

6 files changed, 109 insertions, 15 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2931059..5290312 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,27 @@
+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.
+
 2015-11-12  Ed Schonberg  <schonberg@adacore.com>
 
 	* sem_ch8.adb (Find_Selected_Component): In a synchronized
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index e84719a..e36533a 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -155,7 +155,7 @@ procedure Gnat1drv is
          Operating_Mode := Generate_Code;
 
          --  Suppress alignment checks since we do not have access to alignment
-         --  info on the target
+         --  info on the target.
 
          Suppress_Options.Suppress (Alignment_Check) := False;
       end if;
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 60aeb28..9041a88 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -200,7 +200,7 @@ package Opt is
 
    Alternate_Main_Name : String_Ptr := null;
    --  GNATBIND
-   --  Set to non null when Bind_Alternate_Main_Name is True. This value
+   --  Set to non-null when Bind_Alternate_Main_Name is True. This value
    --  is modified as needed by Gnatbind.Scan_Bind_Arg.
 
    ASIS_Mode : Boolean := False;
@@ -424,7 +424,7 @@ package Opt is
    --  The value given to the -g parameter. The default value for -g with
    --  no value is 2. If no -g is specified, defaults to 0.
    --  Note that the generated code should never depend on this variable,
-   --  since we want debug info to be non intrusive on the generate code.
+   --  since we want debug info to be nonintrusive on the generate code.
 
    Default_Exit_Status : Int := 0;
    --  GNATBIND
@@ -1317,8 +1317,8 @@ package Opt is
 
    Setup_Projects : Boolean := False;
    --  GNAT DRIVER
-   --  Set to True for GNAT SETUP: the Project Manager creates non existing
-   --  object, library and exec directories.
+   --  Set to True for GNAT SETUP: the Project Manager creates nonexistent
+   --  object, library, and exec directories.
 
    Shared_Libgnat : Boolean;
    --  GNATBIND
@@ -1880,7 +1880,7 @@ package Opt is
    --  to date version of Ada).
 
    Ada_Version_Pragma_Config : Node_Id;
-   --  This will be set non empty if it is set by a configuration pragma
+   --  This will be set nonempty if it is set by a configuration pragma
 
    Ada_Version_Explicit_Config : Ada_Version_Type;
    --  GNAT
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index a82385e..31f6bd2 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -3270,6 +3270,8 @@ package body Sem_Ch3 is
          Rewrite (E, Make_Integer_Literal (Sloc (N), 1));
          Set_Etype (E, Any_Type);
       end if;
+
+      Analyze_Dimension (N);
    end Analyze_Number_Declaration;
 
    --------------------------------
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 --
    ------------------------------------------
 
diff --git a/gcc/ada/sem_dim.ads b/gcc/ada/sem_dim.ads
index 7393bf6..d1521e9 100644
--- a/gcc/ada/sem_dim.ads
+++ b/gcc/ada/sem_dim.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2011-2013, Free Software Foundation, Inc.         --
+--          Copyright (C) 2011-2015, 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- --
@@ -116,8 +116,10 @@ package Sem_Dim is
    --    * compontent declaration
    --    * extended return statement
    --    * expanded name
+   --    * explicit dereference
    --    * identifier
    --    * indexed component
+   --    * number declaration
    --    * object declaration
    --    * object renaming declaration
    --    * procedure call statement