For GNAT dimensionality checking system, accept constant declaration
whose type is a dimensioned type when an initialization expression with
dimension is present.
The test presented below highlights this new patch:
------------
-- Source --
------------
with System.Dim.Mks_IO; use System.Dim.Mks_IO;
with System.Dim.Mks; use System.Dim.Mks;
procedure Main is
My_Cons : constant Mks_Type := cm * g**2;
begin
Put_Dim_Of (My_Cons);
end Main;
-------------------------------
-- Compilation and Execution --
-------------------------------
$ gnatmake -q -gnat12 main.adb
$ ./main
------------
-- Output --
------------
[L.M**2]
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-07-23 Vincent Pucci <pu...@adacore.com>
* sem_dim.adb (Analyze_Dimension_Has_Etype): For identifier, propagate
dimension when entity is a non-dimensionless constant.
(Analyze_Dimension_Object_Declaration): Propagate
dimension from the expression to the entity when type is a
dimensioned type and object is a constant.
Index: sem_dim.adb
===================================================================
--- sem_dim.adb (revision 189768)
+++ sem_dim.adb (working copy)
@@ -1617,6 +1617,14 @@
if Exists (Dims_Of_Etyp) then
Set_Dimensions (N, Dims_Of_Etyp);
+
+ -- Propagation of the dimensions from the entity for identifier whose
+ -- entity is a non-dimensionless consant.
+
+ elsif Nkind (N) = N_Identifier
+ and then Exists (Dimensions_Of (Entity (N)))
+ then
+ Set_Dimensions (N, Dimensions_Of (Entity (N)));
end if;
-- Removal of dimensions in expression
@@ -1692,7 +1700,7 @@
if Present (Expr) then
Dim_Of_Expr := Dimensions_Of (Expr);
- -- case when expression is not a literal and when dimensions of the
+ -- Case when expression is not a literal and when dimensions of the
-- expression and of the type mismatch
if not Nkind_In (Original_Node (Expr),
@@ -1700,7 +1708,20 @@
N_Integer_Literal)
and then Dim_Of_Expr /= Dim_Of_Etyp
then
- Error_Dim_Msg_For_Object_Declaration (N, Etyp, Expr);
+ -- Propagate the dimension from the expression to the object
+ -- entity when the object is a constant whose type is a
+ -- dimensioned type.
+
+ if Constant_Present (N)
+ and then not Exists (Dim_Of_Etyp)
+ then
+ Set_Dimensions (Id, Dim_Of_Expr);
+
+ -- Otherwise, issue an error message
+
+ else
+ Error_Dim_Msg_For_Object_Declaration (N, Etyp, Expr);
+ end if;
end if;
-- Removal of dimensions in expression
