[Ada] Spurious dimensionality error on aggregate with "others" assoc.

[Ada] Spurious dimensionality error on aggregate with "others" assoc.

[Pierre-Marie de Rodat]

[-- Attachment #1: Type: text/plain, Size: 750 bytes --]

This patch fixes a spurious dimensionality error on an array aggregate
with a single "others' clause whose expression is a dimensioned entity,
The expansion of the aggregate may create copies of the expression, and
the dimensionality check must use the type of the expression to retrieve
the proper dimension information to check against the dimensions of the
array component type.

Tested on x86_64-pc-linux-gnu, committed on trunk

2019-07-04  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_dim.adb (Analyze_Dimension_Array_Aggregate): If the
	component is an entity name, its dimensions are those of its
	type.

gcc/testsuite/

	* gnat.dg/dimensions2.adb, gnat.dg/dimensions2_phys.ads,
	gnat.dg/dimensions2_real_numbers.ads: New testcase.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 5618 bytes --]

--- gcc/ada/sem_dim.adb
+++ gcc/ada/sem_dim.adb
@@ -1233,8 +1233,9 @@ package body Sem_Dim is
       Dims_Of_Comp_Typ : constant Dimension_Type := Dimensions_Of (Comp_Typ);
       Exps             : constant List_Id        := Expressions (N);
 
-      Comp : Node_Id;
-      Expr : Node_Id;
+      Comp         : Node_Id;
+      Dims_Of_Expr : Dimension_Type;
+      Expr         : Node_Id;
 
       Error_Detected : Boolean := False;
       --  This flag is used in order to indicate if an error has been detected
@@ -1281,11 +1282,19 @@ package body Sem_Dim is
          --  (may happen when an aggregate is converted into a positional
          --  aggregate). We also must verify that this is a scalar component,
          --  and not a subaggregate of a multidimensional aggregate.
+         --  The expression may be an identifier that has been copied several
+         --  times during expansion, its dimensions are those of its type.
+
+         if Is_Entity_Name (Expr) then
+            Dims_Of_Expr := Dimensions_Of (Etype (Expr));
+         else
+            Dims_Of_Expr := Dimensions_Of (Expr);
+         end if;
 
          if Comes_From_Source (Original_Node (Expr))
            and then Present (Etype (Expr))
            and then Is_Numeric_Type (Etype (Expr))
-           and then Dimensions_Of (Expr) /= Dims_Of_Comp_Typ
+           and then Dims_Of_Expr /= Dims_Of_Comp_Typ
            and then Sloc (Comp) /= Sloc (Prev (Comp))
          then
             --  Check if an error has already been encountered so far

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/dimensions2.adb
@@ -0,0 +1,20 @@
+--  { dg-do compile }
+
+with Dimensions2_phys; use Dimensions2_phys;
+
+procedure Dimensions2 is
+
+   zero_flow : constant Volumetric_Flow := 0.0 * m**3 / h;
+   type Node_Flow_Scenario_T is array (Positive range <>)
+          of Volumetric_Flow with
+            default_component_value => zero_flow;
+   subtype Max_Node_Flow_Scenario_T
+       is Node_Flow_Scenario_T (Natural (1) .. 48);
+   flow_value_array : Max_Node_Flow_Scenario_T  := (1..48 => zero_flow);
+   flow_value_array1 : Max_Node_Flow_Scenario_T
+        := (Max_Node_Flow_Scenario_T'Range=> zero_flow);
+   flow_value_array2 : Max_Node_Flow_Scenario_T  := (others => zero_flow);
+
+begin
+    null;
+end Dimensions2;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/dimensions2_phys.ads
@@ -0,0 +1,80 @@
+with ada.numerics.generic_elementary_functions;
+with Dimensions2_real_numbers;
+
+package Dimensions2_Phys is
+
+   type si_type is new Dimensions2_real_numbers.Real with
+      dimension_system =>
+      ((unit_name => meter, unit_symbol => 'm', dim_symbol => 'L'),
+       (unit_name => kilogram, unit_symbol => "kg", dim_symbol => 'M'),
+       (unit_name => second, unit_symbol => 's', dim_symbol => 'T'),
+       (unit_name => ampere, unit_symbol => 'A', dim_symbol => 'I'),
+       (unit_name => kelvin, unit_symbol => 'K', dim_symbol => "Theta"),
+       (unit_name => mole, unit_symbol => "mol", dim_symbol => 'N'),
+       (unit_name => euro, unit_symbol => "EUR", dim_symbol => 'E'));
+
+   subtype distance is Si_Type with
+        dimension => (symbol => 'm', meter => 1, others => 0);
+
+   subtype mass is Si_Type with
+        dimension => (symbol => "kg", kilogram => 1, others => 0);
+
+   subtype time is Si_Type with
+        dimension => (symbol => 's', second => 1, others => 0);
+
+   subtype electric_current is Si_Type with
+        dimension => (symbol => 'A', ampere => 1, others => 0);
+
+   subtype temperature is Si_Type with
+        dimension => (symbol => 'K', kelvin => 1, others => 0);
+
+   subtype amount_of_substance is Si_Type with
+        dimension => (symbol => "mol", mole => 1, others => 0);
+
+   pragma warnings (off, "*assumed to be*");
+   subtype pressure_barg is Dimensions2_real_numbers.Real;
+   m : constant Distance := 1.0;
+   kg : constant Mass := 1.0;
+   s : constant Time := 1.0;
+   a : constant Electric_Current := 1.0;
+   k : constant Temperature := 1.0;
+   mol : constant Amount_Of_Substance := 1.0;
+   min : constant Time := 1.0;
+   h : constant Time := 60.0 * min;
+
+   subtype frequency is Si_Type with
+        dimension => (symbol => "Hz", second => -1, others => 0);
+
+   subtype massflow is Si_Type with
+     dimension => (symbol => "kg/s",
+       kilogram => 1, second => -1, others => 0);
+
+   subtype molar_heat_capacity is Si_Type with
+     dimension => (symbol => "J/(K*mol)", meter => 2, kilogram => 1,
+       second => -2, kelvin => -1, mole => -1, others => 0);
+
+   subtype molar_flow is Si_Type with
+      dimension => (symbol => "mol/s", second => -1, mole => 1, others => 0);
+
+   subtype pressure is Si_Type with
+    dimension =>
+     (symbol => "Pa", meter => -1, kilogram => 1, second => -2, others => 0);
+
+   subtype ratio is Si_Type range 0.0 .. 1.0;
+
+   subtype scalar is Si_Type;
+
+   subtype specific_heat_capacity is Si_Type with
+     dimension => (symbol => "J/(K*kg)", meter => 2, second => -2,
+       kelvin => -1, others => 0);
+
+   subtype speed is Si_Type with
+     dimension => (symbol => "m/s", meter => 1, second => -1, others => 0);
+
+   subtype volume is Si_Type with
+        dimension => (symbol => "m^3", meter => 3, others => 0);
+
+   subtype volumetric_flow is Si_Type with
+     dimension => (symbol => "m^3/s", meter => 3, second => -1, others => 0);
+
+end Dimensions2_Phys;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/dimensions2_real_numbers.ads
@@ -0,0 +1,3 @@
+package Dimensions2_Real_Numbers is
+  type Real is new Long_Float;
+end;