===================================================================
@@ -35,6 +35,7 @@
with Opt; use Opt;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
+with Sem_Aux; use Sem_Aux;
with Sem_Eval; use Sem_Eval;
with Sem_Res; use Sem_Res;
with Sem_Util; use Sem_Util;
@@ -280,6 +281,14 @@
-- both the identifier and the parent type of N are not dimensionless,
-- return an error.
+ procedure Analyze_Dimension_Type_Conversion (N : Node_Id);
+ -- Type conversions handle conversions between literals and dimensioned
+ -- types, from dimensioned types to their base type, and between different
+ -- dimensioned systems. Dimensions of the conversion are obtained either
+ -- from those of the expression, or from the target type, and dimensional
+ -- consistency must be checked when converting between values belonging
+ -- to different dimensioned systems.
+
procedure Analyze_Dimension_Unary_Op (N : Node_Id);
-- Subroutine of Analyze_Dimension for unary operators. For Plus, Minus and
-- Abs operators, propagate the dimensions from the operand to N.
@@ -301,6 +310,11 @@
-- dimension" if Description_Needed. if N is dimensionless, return "'[']",
-- or "is dimensionless" if Description_Needed.
+ function Dimension_System_Root (T : Entity_Id) return Entity_Id;
+ -- Given a type that has dimension information, return the type that is the
+ -- root of its dimension system, e.g. Mks_Type. If T is not a dimensioned
+ -- type, i.e. a standard numeric type, return Empty.
+
procedure Dim_Warning_For_Numeric_Literal (N : Node_Id; Typ : Entity_Id);
-- Issue a warning on the given numeric literal N to indicate that the
-- compiler made the assumption that the literal is not dimensionless
@@ -1191,13 +1205,7 @@
Analyze_Dimension_Subtype_Declaration (N);
when N_Type_Conversion =>
- if In_Instance
- and then Exists (Dimensions_Of (Expression (N)))
- then
- Set_Dimensions (N, Dimensions_Of (Expression (N)));
- else
- Analyze_Dimension_Has_Etype (N);
- end if;
+ Analyze_Dimension_Type_Conversion (N);
when N_Unary_Op =>
Analyze_Dimension_Unary_Op (N);
@@ -1384,26 +1392,6 @@
return Dimensions_Of (Etype (N));
end if;
- -- A type conversion may have been inserted to rewrite other
- -- expressions, e.g. function returns. Dimensions are those of
- -- the target type, unless this is a conversion in an instance,
- -- in which case the proper dimensions are those of the operand,
-
- elsif Nkind (N) = N_Type_Conversion then
- if In_Instance
- and then Is_Generic_Actual_Type (Etype (Expression (N)))
- then
- return Dimensions_Of (Etype (Expression (N)));
-
- elsif In_Instance
- and then Exists (Dimensions_Of (Expression (N)))
- then
- return Dimensions_Of (Expression (N));
-
- else
- return Dimensions_Of (Etype (N));
- end if;
-
-- Otherwise return the default dimensions
else
@@ -2339,6 +2327,56 @@
end if;
end Analyze_Dimension_Subtype_Declaration;
+ ---------------------------------------
+ -- Analyze_Dimension_Type_Conversion --
+ ---------------------------------------
+
+ procedure Analyze_Dimension_Type_Conversion (N : Node_Id) is
+ Expr_Root : constant Entity_Id :=
+ Dimension_System_Root (Etype (Expression (N)));
+ Target_Root : constant Entity_Id :=
+ Dimension_System_Root (Etype (N));
+
+ begin
+ -- If the expression has dimensions and the target type has dimensions,
+ -- the conversion has the dimensions of the expression. Consistency is
+ -- checked below. Converting to a non-dimensioned type such as Float
+ -- ignores the dimensions of the expression.
+
+ if Exists (Dimensions_Of (Expression (N)))
+ and then Present (Target_Root)
+ then
+ Set_Dimensions (N, Dimensions_Of (Expression (N)));
+
+ -- Otherwise the dimensions are those of the target type.
+
+ else
+ Analyze_Dimension_Has_Etype (N);
+ end if;
+
+ -- A conversion between types in different dimension systems (e.g. MKS
+ -- and British units) must respect the dimensions of expression and
+ -- type, It is up to the user to provide proper conversion factors.
+
+ -- Upward conversions to root type of a dimensioned system are legal,
+ -- and correspond to "view conversions", i.e. preserve the dimensions
+ -- of the expression; otherwise conversion must be between types with
+ -- then same dimensions. Conversions to a non-dimensioned type such as
+ -- Float lose the dimensions of the expression.
+
+ if Present (Expr_Root)
+ and then Present (Target_Root)
+ and then Etype (N) /= Target_Root
+ and then Dimensions_Of (Expression (N)) /= Dimensions_Of (Etype (N))
+ then
+ Error_Msg_N ("dimensions mismatch in conversion", N);
+ Error_Msg_N
+ ("\expression " & Dimensions_Msg_Of (Expression (N), True), N);
+ Error_Msg_N
+ ("\target type " & Dimensions_Msg_Of (Etype (N), True), N);
+ end if;
+ end Analyze_Dimension_Type_Conversion;
+
--------------------------------
-- Analyze_Dimension_Unary_Op --
--------------------------------
@@ -2665,6 +2703,24 @@
or else Dimensions_Of (T1) = Dimensions_Of (T2);
end Dimensions_Match;
+ ---------------------------
+ -- Dimension_System_Root --
+ ---------------------------
+
+ function Dimension_System_Root (T : Entity_Id) return Entity_Id is
+ Root : Entity_Id;
+
+ begin
+ Root := Base_Type (T);
+
+ if Has_Dimension_System (Root) then
+ return First_Subtype (Root); -- for example Dim_Mks
+
+ else
+ return Empty;
+ end if;
+ end Dimension_System_Root;
+
----------------------------------------
-- Eval_Op_Expon_For_Dimensioned_Type --
----------------------------------------
This patch implements the proper handling of dimension information on type conversions. Given a conversion T (Expr), where the expression has type TE, the following cases arise: a) If TE has dimension information, the dimensions of the conversion are those of TE. b) If TE has no dimension information, dimensions of conversion are those of T. c) If T and TE belong to different dimension systems, they must have identical dimensions, unless T is the root type of its system, in which case dimensions are those of TE, and the conversion can be seen as a "view conversion" that preserves the dimensions of its argument. d) If T is a non-dimensioned type, such a Standard.Float, the conversion has no dimension information. The following must compile quietly: gcc -c main.adb gcc -c -gnatd.F main.adb --- with Units; use Units; procedure main with SPARK_Mode is subtype Servo_Angle_Type is Units.Angle_Type range -40.0 * Degree .. 40.0 * Degree; function Sat_Servo_Angle is new Saturated_Cast (Servo_Angle_Type); begin null; end main; --- with Ada.Numerics; package units with SPARK_Mode is type Unit_Type is new Float 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 => Radian, Unit_Symbol => "Rad", Dim_Symbol => "A")), Default_Value => 0.0; -- required for matrices subtype Angle_Type is Unit_Type with Dimension => (Symbol => "Rad", Radian => 1, others => 0); Degree : constant Angle_Type := Angle_Type (2.0 * Ada.Numerics.Pi / 360.0); generic type T is digits <>; function Saturated_Cast (val : Float) return T with Inline; -- convert a float into a more specific float type, and trim -- to the value range end units; --- package body units with SPARK_Mode is function Saturated_Cast (val : Float) return T is ret : T; begin if val >= Float (T'Last) then ret := T'Last; elsif val <= Float (T'First) then ret := T'First; else ret := T (val); end if; return ret; end Saturated_Cast; end units; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-09-07 Ed Schonberg <schonberg@adacore.com> * sem_dim.adb (Analyze_Dimension_Type_Conversion): New procedure to handle properly various cases of type conversions where the target type and/or the expression carry dimension information. (Dimension_System_Root); If a subtype carries dimension information, obtain the source parent type that carries the Dimension aspect.