From dcd59a994affdd191d7025269b18a1043f80a47f Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Thu, 4 Jul 2019 08:05:03 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 6 ++ gcc/ada/sem_dim.adb | 15 +++- gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gnat.dg/dimensions2.adb | 20 ++++++ gcc/testsuite/gnat.dg/dimensions2_phys.ads | 80 ++++++++++++++++++++++ gcc/testsuite/gnat.dg/dimensions2_real_numbers.ads | 3 + 6 files changed, 126 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/dimensions2.adb create mode 100644 gcc/testsuite/gnat.dg/dimensions2_phys.ads create mode 100644 gcc/testsuite/gnat.dg/dimensions2_real_numbers.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c28a942..62f031c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-07-04 Ed Schonberg + + * 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 * 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 43b1f23..26c8008 100644 --- 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 9021bd7..7147482 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-07-04 Ed Schonberg + + * gnat.dg/dimensions2.adb, gnat.dg/dimensions2_phys.ads, + gnat.dg/dimensions2_real_numbers.ads: New testcase. + 2019-07-04 Jakub Jelinek PR tree-optimization/91063 diff --git a/gcc/testsuite/gnat.dg/dimensions2.adb b/gcc/testsuite/gnat.dg/dimensions2.adb new file mode 100644 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 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 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; -- 2.7.4