diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/ada/sem_dim.adb | 15 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/dimensions2.adb | 20 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/dimensions2_phys.ads | 80 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/dimensions2_real_numbers.ads | 3 |
6 files changed, 126 insertions, 3 deletions
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 <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 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 <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 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; |