Patchwork [Ada] Improve GNAT dimensionality checking system

login
register
mail settings
Submitter Arnaud Charlet
Date July 23, 2012, 8:13 a.m.
Message ID <20120723081323.GA5270@adacore.com>
Download mbox | patch
Permalink /patch/172572/
State New
Headers show

Comments

Arnaud Charlet - July 23, 2012, 8:13 a.m.
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  <pucci@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.

Patch

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