===================================================================
@@ -518,25 +518,17 @@
Position : Dimension_Position)
is
begin
- -- Integer case
+ Dimensions (Position) := Create_Rational_From (Expr, True);
+ Processed (Position) := True;
- if Is_Integer_Type (Def_Id) then
+ -- If the dimensioned root type is an integer type, it is not
+ -- particularly useful, and fractional dimensions do not make
+ -- much sense for such types, so previously we used to reject
+ -- dimensions of integer types that were not integer literals.
+ -- However, the manipulation of dimensions does not depend on
+ -- the kind of root type, so we can accept this usage for rare
+ -- cases where dimensions are specified for integer values.
- -- Dimension value must be an integer literal
-
- if Nkind (Expr) = N_Integer_Literal then
- Dimensions (Position) := +Whole (UI_To_Int (Intval (Expr)));
- else
- Error_Msg_N ("integer literal expected", Expr);
- end if;
-
- -- Float case
-
- else
- Dimensions (Position) := Create_Rational_From (Expr, True);
- end if;
-
- Processed (Position) := True;
end Extract_Power;
------------------------
If the dimensioned root type is an integer type, it is not particularly useful, and fractional dimensions do not make much sense for such types, so previously we used to reject dimensions of integer types that were not integer literals. However, the manipulation of dimensions does not depend on the kind of root type, so we can accept this usage for rare cases where dimensions are specified for integer-valued types. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ 2017-10-20 Ed Schonberg <schonberg@adacore.com> * sem_dim.adb (Extract_Power): Accept dimension values that are not non-negative integers when the dimensioned base type is an Integer type. gcc/testsuite/ 2017-10-20 Ed Schonberg <schonberg@adacore.com> * gnat.dg/dimensions.adb, gnat.dg/dimensions.ads: New testcase. Index: gnat.dg/dimensions.adb =================================================================== --- gnat.dg/dimensions.adb (revision 0) +++ gnat.dg/dimensions.adb (revision 253941) @@ -0,0 +1,5 @@ +-- { dg-do compile } + +package body Dimensions is + procedure Dummy is null; +end Dimensions; Index: gnat.dg/dimensions.ads =================================================================== --- gnat.dg/dimensions.ads (revision 0) +++ gnat.dg/dimensions.ads (revision 253941) @@ -0,0 +1,29 @@ +package Dimensions is + + type Mks_Int_Type is new Integer + 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 => '@'), + (Unit_Name => Mole, Unit_Symbol => "mol", Dim_Symbol => 'N'), + (Unit_Name => Candela, Unit_Symbol => "cd", Dim_Symbol => 'J')); + + subtype Int_Length is Mks_Int_Type + with + Dimension => (Symbol => 'm', + Meter => 1, + others => 0); + + subtype Int_Speed is Mks_Int_Type + with + Dimension => ( + Meter => 1, + Second => -1, + others => 0); + + procedure Dummy; + +end Dimensions;