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

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.

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.

From-SVN: r273043

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c28a9422aad21baf479f0e34b0a1cc9f8b4aa1aa..62f031cb5cfb4deb300ef99821dc69a4da48dba1 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2019-07-04  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_dim.adb (Analyze_Dimension_Array_Aggregate): If the
+       component is an entity name, its dimensions are those of its
+       type.
+
 2019-07-03  Bob Duff  <duff@adacore.com>
 
        * doc/gnat_ugn/gnat_utility_programs.rst: Document new flags in

diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb
index 43b1f23373600e1cd00d5a74ccb640989bdeb024..26c8008b573d4a3901396df397d97ce5a5cdf8a5 100644 (file)
--- a/gcc/ada/sem_dim.adb
+++ b/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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9021bd781202cdde76e4c3630eafca10c24e6cf4..714748238dae40dd37a9927460b5f7c4ded9b13a 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-07-04  Ed Schonberg  <schonberg@adacore.com>
+
+       * gnat.dg/dimensions2.adb, gnat.dg/dimensions2_phys.ads,
+       gnat.dg/dimensions2_real_numbers.ads: New testcase.
+
 2019-07-04  Jakub Jelinek  <jakub@redhat.com>
 
        PR tree-optimization/91063

diff --git a/gcc/testsuite/gnat.dg/dimensions2.adb b/gcc/testsuite/gnat.dg/dimensions2.adb
new file mode 100644 (file)
index 0000000..630a44f
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/dimensions2_phys.ads b/gcc/testsuite/gnat.dg/dimensions2_phys.ads
new file mode 100644 (file)
index 0000000..675352a
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/dimensions2_real_numbers.ads b/gcc/testsuite/gnat.dg/dimensions2_real_numbers.ads
new file mode 100644 (file)
index 0000000..e7cda0b
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/dimensions2_real_numbers.ads
@@ -0,0 +1,3 @@
+package Dimensions2_Real_Numbers is
+  type Real is new Long_Float;
+end;