Patchwork [Ada] New addition to the GNAT dimensionality checking system

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 1, 2012, 10:07 a.m.
Message ID <20121001100743.GA14939@adacore.com>
Download mbox | patch
Permalink /patch/188270/
State New
Headers show

Comments

Arnaud Charlet - Oct. 1, 2012, 10:07 a.m.
This patch implements dimension analysis for array, extension and record
aggregates, and also for calls. Moreover, the compiler warns whenever a numeric
literal is used as a default value of a dimensioned subtype object (object
declaration, component declaration and formal parameter).

The test presented below illustrates some of the new additions, in particular
the dimension anlysis of aggregates.

------------
-- Source --
------------

with Ada.Text_IO;       use Ada.Text_IO;
with System.Dim.Mks;    use System.Dim.Mks;
with System.Dim.Mks_IO; use System.Dim.Mks_IO;

procedure Main is
   subtype Axis is Integer range 1 .. 3;
   type Position is array (Axis) of Length;

   type Particle is record
     Q: Mass     := 0.0;
     R: Position := (Axis => 0.0 * m);
   end record;

   P : Particle := (Q => 1.0 * g, R => (Axis => 0.0 * m));

begin
   Put (P.Q, Aft => 2, Exp => 0);  New_Line;

   for C of P.R loop
      Put (C, Aft => 2, Exp => 0);  New_Line;
   end loop;
end Main;

-----------------------------
-- Compilation & Execution --
-----------------------------

$ gnatmake -q -gnat12 main.adb
$ ./main
main.adb:10:21: warning: assumed to be "0.0 kg"
 0.00 kg
 0.00 m
 0.00 m
 0.00 m

Tested on x86_64-pc-linux-gnu, committed on trunk

2012-10-01  Vincent Pucci  <pucci@adacore.com>

	* exp_ch6.adb (Expand_Call): Remove call to
	Remove_Dimension_In_Call.
	* sem_aggr.adb (Resolve_Array_Aggregate): Analyze dimension of
	components in array aggregate.
	(Resolve_Aggr_Expr): Propagate dimensions from the original expression
	Expr to the new created expression New_Expr when resolving the
	expression of a component in record aggregates.
	(Resolve_Record_Aggregate): Analyze
	dimension of components in record (or extension) aggregate.
	* sem_ch6.adb (Analyze_Subprogram_Specification): Analyze
	dimension of formals with default expressions in subprogram
	specification.
	* sem_ch8.adb (Analyze_Expanded_Name): Analyze dimension of
	expanded names.
	(Find_Selected_Component): Analyze dimension of selected component.
	* sem_dim.adb: Several dimension error messages reformatting.
	(Dimensions_Msg_Of): New flag Description_Needed in order to
	differentiate two different sort of dimension error messages.
	(Dim_Warning_For_Numeric_Literal): New routine.
	(Exists): New routine.
	(Move_Dimensions): Routine spec moved to spec file.
	* sem_dim.ads (String_From_Numeric_Literal): New routine.
	(Analyze_Dimension): Analyze dimension only when the
	node comes from source.  Dimension analysis for expanded names added.
	(Analyze_Dimension_Array_Aggregate): New routine.
	(Analyze_Dimension_Call): New routine.
	(Analyze_Dimension_Component_Declaration): Warning if default
	expression is a numeric literal.
	(Analyze_Dimension_Extension_Or_Record_Aggregate): New routine.
	(Analyze_Dimension_Formals): New routine.
	(Analyze_Dimension_Object_Declaration): Warning if default
	expression is a numeric literal.
	(Symbol_Of): Return either the dimension subtype symbol or the
	dimension symbol built by From_Dim_To_Str_Of_Unit_Symbols.
	* sem_dim.ads (Analyze_Dimension_Array_Aggregate): New routine.
	(Analyze_Dimension_Call): New routine.
	(Analyze_Dimension_Extension_Or_Record_Aggregate): New routine.
	(Analyze_Dimension_Formals): New routine.
	(Move_Dimensions): Moved from sem_dim.adb.
	* s-dimmks.ads: Turn off the warnings for dimensioned object
	declaration.  Dimensioned subtypes sorted in alphabetical
	order. New subtypes Area, Speed, Volume.
	* s-dmotpr.ads: Turn off the warnings for dimensioned object
	declaration.
	* sem_res.adb (Resolve_Call): Analyze dimension for calls.

Patch

Index: sem_aggr.adb
===================================================================
--- sem_aggr.adb	(revision 191889)
+++ sem_aggr.adb	(working copy)
@@ -47,6 +47,7 @@ 
 with Sem_Ch3;  use Sem_Ch3;
 with Sem_Ch8;  use Sem_Ch8;
 with Sem_Ch13; use Sem_Ch13;
+with Sem_Dim;  use Sem_Dim;
 with Sem_Eval; use Sem_Eval;
 with Sem_Res;  use Sem_Res;
 with Sem_Util; use Sem_Util;
@@ -2549,6 +2550,10 @@ 
              Duplicate_Subexpr (High_Bound (Aggregate_Bounds (N))));
       end if;
 
+      --  Check the dimensions of each component in the array aggregate.
+
+      Analyze_Dimension_Array_Aggregate (N, Component_Typ);
+
       return Success;
    end Resolve_Array_Aggregate;
 
@@ -3225,8 +3230,9 @@ 
       -----------------------
 
       procedure Resolve_Aggr_Expr (Expr : Node_Id; Component : Node_Id) is
+         Expr_Type : Entity_Id := Empty;
          New_C     : Entity_Id := Component;
-         Expr_Type : Entity_Id := Empty;
+         New_Expr  : Node_Id;
 
          function Has_Expansion_Delayed (Expr : Node_Id) return Boolean;
          --  If the expression is an aggregate (possibly qualified) then its
@@ -3380,10 +3386,17 @@ 
          end if;
 
          if Relocate then
-            Add_Association (New_C, Relocate_Node (Expr), New_Assoc_List);
+            New_Expr := Relocate_Node (Expr);
+
+            --  Since New_Expr is not gonna be analyzed later on, we need to
+            --  propagate here the dimensions form Expr to New_Expr.
+
+            Move_Dimensions (Expr, New_Expr);
          else
-            Add_Association (New_C, Expr, New_Assoc_List);
+            New_Expr := Expr;
          end if;
+
+         Add_Association (New_C, New_Expr, New_Assoc_List);
       end Resolve_Aggr_Expr;
 
    --  Start of processing for Resolve_Record_Aggregate
@@ -4490,6 +4503,10 @@ 
 
          Rewrite (N, New_Aggregate);
       end Step_8;
+
+      --  Check the dimensions of the components in the record aggregate.
+
+      Analyze_Dimension_Extension_Or_Record_Aggregate (N);
    end Resolve_Record_Aggregate;
 
    -----------------------------
Index: sem_dim.adb
===================================================================
--- sem_dim.adb	(revision 191888)
+++ sem_dim.adb	(working copy)
@@ -36,7 +36,9 @@ 
 with Sem;      use Sem;
 with Sem_Eval; use Sem_Eval;
 with Sem_Res;  use Sem_Res;
+with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
+with Sinput;   use Sinput;
 with Snames;   use Snames;
 with Stand;    use Stand;
 with Stringt;  use Stringt;
@@ -190,6 +192,7 @@ 
 
    OK_For_Dimension : constant array (Node_Kind) of Boolean :=
      (N_Attribute_Reference       => True,
+      N_Expanded_Name             => True,
       N_Defining_Identifier       => True,
       N_Function_Call             => True,
       N_Identifier                => True,
@@ -236,14 +239,6 @@ 
    --  that the dimensions of the returned type and of the returned object
    --  match.
 
-   procedure Analyze_Dimension_Function_Call (N : Node_Id);
-   --  Subroutine of Analyze_Dimension for function call. General case:
-   --  propagate the dimensions from the returned type to N. Elementary
-   --  function case (Ada.Numerics.Generic_Elementary_Functions): If N
-   --  is a Sqrt call, then evaluate the resulting dimensions as half the
-   --  dimensions of the parameter. Otherwise, verify that each parameters
-   --  are dimensionless.
-
    procedure Analyze_Dimension_Has_Etype (N : Node_Id);
    --  Subroutine of Analyze_Dimension for a subset of N_Has_Etype denoted by
    --  the list below:
@@ -292,10 +287,18 @@ 
    function Dimensions_Of (N : Node_Id) return Dimension_Type;
    --  Return the dimension vector of node N
 
-   function Dimensions_Msg_Of (N : Node_Id) return String;
-   --  Given a node, return "has dimension" followed by the dimension symbols
-   --  of N or "is dimensionless" if N is dimensionless.
+   function Dimensions_Msg_Of
+      (N                  : Node_Id;
+       Description_Needed : Boolean := False) return String;
+   --  Given a node N, return the dimension symbols of N, preceded by "has
+   --  dimension" if Description_Needed. if N is dimensionless, return "[]", or
+   --  "is dimensionless" if Description_Needed.
 
+   procedure Dim_Warning_For_Numeric_Literal (N : Node_Id; Typ : Entity_Id);
+   --  Issue a warning on the given numeric literal N to indicate the
+   --  compilateur made the assumption that the literal is not dimensionless
+   --  but has the dimension of Typ.
+
    procedure Eval_Op_Expon_With_Rational_Exponent
      (N              : Node_Id;
       Exponent_Value : Rational);
@@ -304,6 +307,9 @@ 
    function Exists (Dim : Dimension_Type) return Boolean;
    --  Returns True iff Dim does not denote the null dimension
 
+   function Exists (Str : String_Id) return Boolean;
+   --  Returns True iff Str does not denote No_String
+
    function Exists (Sys : System_Type) return Boolean;
    --  Returns True iff Sys does not denote the null system
 
@@ -330,9 +336,6 @@ 
    function Is_Invalid (Position : Dimension_Position) return Boolean;
    --  Return True if Pos denotes the invalid position
 
-   procedure Move_Dimensions (From : Node_Id; To : Node_Id);
-   --  Copy dimension vector of From to To, delete dimension vector of From
-
    procedure Remove_Dimensions (N : Node_Id);
    --  Remove the dimension vector of node N
 
@@ -342,6 +345,10 @@ 
    procedure Set_Symbol (E : Entity_Id; Val : String_Id);
    --  Associate a symbol representation of a dimension vector with a subtype
 
+   function String_From_Numeric_Literal (N : Node_Id) return String_Id;
+   --  Return the string that corresponds to the numeric litteral N as it
+   --  appears in the source.
+
    function Symbol_Of (E : Entity_Id) return String_Id;
    --  E denotes a subtype with a dimension. Return the symbol representation
    --  of the dimension vector.
@@ -1122,14 +1129,16 @@ 
 
    procedure Analyze_Dimension (N : Node_Id) is
    begin
-      --  Aspect is an Ada 2012 feature
+      --  Aspect is an Ada 2012 feature. Note that there is no need to check
+      --  dimensions for nodes that don't come from source.
 
-      if Ada_Version < Ada_2012 then
+      if Ada_Version < Ada_2012
+        or else not Comes_From_Source (N)
+      then
          return;
       end if;
 
       case Nkind (N) is
-
          when N_Assignment_Statement =>
             Analyze_Dimension_Assignment_Statement (N);
 
@@ -1142,10 +1151,8 @@ 
          when N_Extended_Return_Statement =>
             Analyze_Dimension_Extended_Return_Statement (N);
 
-         when N_Function_Call =>
-            Analyze_Dimension_Function_Call (N);
-
          when N_Attribute_Reference       |
+              N_Expanded_Name             |
               N_Identifier                |
               N_Indexed_Component         |
               N_Qualified_Expression      |
@@ -1177,6 +1184,95 @@ 
       end case;
    end Analyze_Dimension;
 
+   ---------------------------------------
+   -- Analyze_Dimension_Array_Aggregate --
+   ---------------------------------------
+
+   procedure Analyze_Dimension_Array_Aggregate
+     (N        : Node_Id;
+      Comp_Typ : Entity_Id)
+   is
+      Comp_Ass         : constant List_Id        := Component_Associations (N);
+      Dims_Of_Comp_Typ : constant Dimension_Type := Dimensions_Of (Comp_Typ);
+      Exps             : constant List_Id        := Expressions (N);
+
+      Comp : Node_Id;
+      Expr : Node_Id;
+
+      Error_Detected : Boolean := False;
+      --  This flag is used in order to indicate if an error has been detected
+      --  so far by the compiler in this routine.
+
+   begin
+      --  Aspect is an Ada 2012 feature. Nothing to do here if the component
+      --  base type is not a dimensioned type.
+
+      --  Note that here the original node must come from source since the
+      --  original array aggregate may not have been entirely decorated.
+
+      if Ada_Version < Ada_2012
+        or else not Comes_From_Source (Original_Node (N))
+        or else not Has_Dimension_System (Base_Type (Comp_Typ))
+      then
+         return;
+      end if;
+
+      --  Check whether there is any positional component association
+
+      if Is_Empty_List (Exps) then
+         Comp := First (Comp_Ass);
+      else
+         Comp := First (Exps);
+      end if;
+
+      while Present (Comp) loop
+         --  Get the expression from the component
+
+         if Nkind (Comp) = N_Component_Association then
+            Expr := Expression (Comp);
+         else
+            Expr := Comp;
+         end if;
+
+         --  Issue an error if the dimensions of the component type and the
+         --  dimensions of the component mismatch.
+
+         --  Note that we must ensure the expression has been fully analyzed
+         --  since it may not be decorated at this point. We also don't want to
+         --  issue the same error message multiple times on the same expression
+         --  (may happen when an aggregate is converted into a positional
+         --  aggregate).
+
+         if Comes_From_Source (Original_Node (Expr))
+           and then Present (Etype (Expr))
+           and then Dimensions_Of (Expr) /= Dims_Of_Comp_Typ
+           and then Sloc (Comp) /= Sloc (Prev (Comp))
+         then
+            --  Check if an error has already been encountered so far
+
+            if not Error_Detected then
+               Error_Msg_N ("dimensions mismatch in array aggregate", N);
+               Error_Detected := True;
+            end if;
+
+            Error_Msg_N ("\expected dimension " &
+                         Dimensions_Msg_Of (Comp_Typ) & ", found " &
+                         Dimensions_Msg_Of (Expr),
+                         Expr);
+         end if;
+
+         --  Look at the named components right after the positional components
+
+         if not Present (Next (Comp))
+           and then List_Containing (Comp) = Exps
+         then
+            Comp := First (Comp_Ass);
+         else
+            Next (Comp);
+         end if;
+      end loop;
+   end Analyze_Dimension_Array_Aggregate;
+
    --------------------------------------------
    -- Analyze_Dimension_Assignment_Statement --
    --------------------------------------------
@@ -1205,8 +1301,8 @@ 
       is
       begin
          Error_Msg_N ("dimensions mismatch in assignment", N);
-         Error_Msg_N ("\left-hand side " & Dimensions_Msg_Of (Lhs), N);
-         Error_Msg_N ("\right-hand side " & Dimensions_Msg_Of (Rhs), N);
+         Error_Msg_N ("\left-hand side " & Dimensions_Msg_Of (Lhs, True), N);
+         Error_Msg_N ("\right-hand side " & Dimensions_Msg_Of (Rhs, True), N);
       end Error_Dim_Msg_For_Assignment_Statement;
 
    --  Start of processing for Analyze_Dimension_Assignment
@@ -1241,8 +1337,8 @@ 
                        "dimensions",
                        N,
                        Entity (N));
-         Error_Msg_N ("\left operand " & Dimensions_Msg_Of (L), N);
-         Error_Msg_N ("\right operand " & Dimensions_Msg_Of (R), N);
+         Error_Msg_N ("\left operand " & Dimensions_Msg_Of (L, True), N);
+         Error_Msg_N ("\right operand " & Dimensions_Msg_Of (R, True), N);
       end Error_Dim_Msg_For_Binary_Op;
 
    --  Start of processing for Analyze_Dimension_Binary_Op
@@ -1390,6 +1486,174 @@ 
       end if;
    end Analyze_Dimension_Binary_Op;
 
+   ----------------------------
+   -- Analyze_Dimension_Call --
+   ----------------------------
+
+   procedure Analyze_Dimension_Call (N : Node_Id; Nam : Entity_Id) is
+      Actuals        : constant List_Id := Parameter_Associations (N);
+      Actual         : Node_Id;
+      Dims_Of_Formal : Dimension_Type;
+      Formal         : Node_Id;
+      Formal_Typ     : Entity_Id;
+
+      Error_Detected : Boolean := False;
+      --  This flag is used in order to indicate if an error has been detected
+      --  so far by the compiler in this routine.
+
+   begin
+      --  Aspect is an Ada 2012 feature. Nothing to do here if the list of
+      --  actuals is empty.Note that there is no need to check dimensions for
+      --  calls that don't come from source.
+
+      if Ada_Version < Ada_2012
+        or else not Comes_From_Source (N)
+        or else Is_Empty_List (Actuals)
+      then
+         return;
+      end if;
+
+      --  Special processing for elementary functions
+
+      --  For Sqrt call, the resulting dimensions equal to half the dimensions
+      --  of the actual. For all other elementary calls, this routine check
+      --  that every actual is dimensionless.
+
+      if Nkind (N) = N_Function_Call then
+         Elementary_Function_Calls : declare
+            Dims_Of_Call : Dimension_Type;
+            Ent          : Entity_Id := Nam;
+
+            function Is_Elementary_Function_Entity
+              (Sub_Id : Entity_Id) return Boolean;
+            --  Given Sub_Id, the original subprogram entity, return True if
+            --  call is to an elementary function
+            --  (see Ada.Numerics.Generic_Elementary_Functions).
+
+            -----------------------------------
+            -- Is_Elementary_Function_Entity --
+            -----------------------------------
+
+            function Is_Elementary_Function_Entity
+              (Sub_Id : Entity_Id) return Boolean
+            is
+               Loc : constant Source_Ptr := Sloc (Sub_Id);
+
+            begin
+               --  Is function entity in
+               --  Ada.Numerics.Generic_Elementary_Functions?
+
+               return
+                 Loc > No_Location
+                   and then
+                     Is_RTU
+                       (Cunit_Entity (Get_Source_Unit (Loc)),
+                         Ada_Numerics_Generic_Elementary_Functions);
+            end Is_Elementary_Function_Entity;
+
+         begin
+            --  Get the original subprogram entity following the renaming chain
+
+            if Present (Alias (Ent)) then
+               Ent := Alias (Ent);
+            end if;
+
+            --  Check the call is an Elementary function call
+
+            if Is_Elementary_Function_Entity (Ent) then
+               --  Sqrt function call case
+
+               if Chars (Ent) = Name_Sqrt then
+                  Dims_Of_Call := Dimensions_Of (First_Actual (N));
+
+                  --  Eavluates the resulting dimensions (i.e. half the
+                  --  dimensions of the actual).
+
+                  if Exists (Dims_Of_Call) then
+                     for Position in Dims_Of_Call'Range loop
+                        Dims_Of_Call (Position) :=
+                          Dims_Of_Call (Position) *
+                            Rational'(Numerator   => 1,
+                                      Denominator => 2);
+                     end loop;
+
+                     Set_Dimensions (N, Dims_Of_Call);
+                  end if;
+
+               --  All other elementary functions case. Note that every actual
+               --  here should be dimensionless.
+
+               else
+                  Actual := First_Actual (N);
+
+                  while Present (Actual) loop
+                     if Exists (Dimensions_Of (Actual)) then
+                        --  Check if an error has already been encountered so
+                        --  far.
+
+                        if not Error_Detected then
+                           Error_Msg_NE ("dimensions mismatch in call of&",
+                                         N, Name (N));
+                           Error_Detected := True;
+                        end if;
+
+                        Error_Msg_N ("\expected dimension [], found " &
+                                     Dimensions_Msg_Of (Actual),
+                                     Actual);
+                     end if;
+
+                     Next_Actual (Actual);
+                  end loop;
+               end if;
+
+               --  Nothing more to do for elementary functions
+
+               return;
+            end if;
+         end Elementary_Function_Calls;
+      end if;
+
+      --  General case. Check, for each parameter, the dimensions of the actual
+      --  and its corresponding formal match. Otherwise, complain.
+
+      Actual  := First_Actual (N);
+      Formal  := First_Formal (Nam);
+
+      while Present (Formal) loop
+         Formal_Typ     := Etype (Formal);
+         Dims_Of_Formal := Dimensions_Of (Formal_Typ);
+
+         --  If the formal is not dimensionless, check dimensions of formal and
+         --  actual match. Otherwise, complain.
+
+         if Exists (Dims_Of_Formal)
+           and then Dimensions_Of (Actual) /= Dims_Of_Formal
+         then
+            --  Check if an error has already been encountered so far
+
+            if not Error_Detected then
+               Error_Msg_NE ("dimensions mismatch in& call", N, Name (N));
+               Error_Detected := True;
+            end if;
+
+            Error_Msg_N ("\expected dimension " &
+                         Dimensions_Msg_Of (Formal_Typ) & ", found " &
+                         Dimensions_Msg_Of (Actual),
+                         Actual);
+         end if;
+
+         Next_Actual (Actual);
+         Next_Formal (Formal);
+      end loop;
+
+      --  For function calls, propagate the dimensions from the returned type
+      --  to the function call.
+
+      if Nkind (N) = N_Function_Call then
+         Analyze_Dimension_Has_Etype (N);
+      end if;
+   end Analyze_Dimension_Call;
+
    ---------------------------------------------
    -- Analyze_Dimension_Component_Declaration --
    ---------------------------------------------
@@ -1418,21 +1682,38 @@ 
          Expr : Node_Id) is
       begin
          Error_Msg_N ("dimensions mismatch in component declaration", N);
-         Error_Msg_N ("\component type " & Dimensions_Msg_Of (Etyp), N);
-         Error_Msg_N ("\component expression " & Dimensions_Msg_Of (Expr), N);
+         Error_Msg_N ("\expected dimension " &
+                      Dimensions_Msg_Of (Etyp) & ", found " &
+                      Dimensions_Msg_Of (Expr),
+                      Expr);
       end Error_Dim_Msg_For_Component_Declaration;
 
    --  Start of processing for Analyze_Dimension_Component_Declaration
 
    begin
+      --  Expression is present
+
       if Present (Expr) then
          Dims_Of_Expr := Dimensions_Of (Expr);
 
-         --  Return an error if the dimension of the expression and the
-         --  dimension of the type mismatch.
+         --  Check dimensions match
 
          if Dims_Of_Etyp /= Dims_Of_Expr then
-            Error_Dim_Msg_For_Component_Declaration (N, Etyp, Expr);
+            --  Numeric literal case. Issue a warning if the object type is not
+            --  dimensionless to indicate the literal is treated as if its
+            --  dimension matches the type dimension.
+
+            if Nkind_In (Original_Node (Expr),
+                             N_Real_Literal,
+                             N_Integer_Literal)
+            then
+               Dim_Warning_For_Numeric_Literal (Expr, Etyp);
+
+            --  Issue a dimension mismatch error for all other cases
+
+            else
+               Error_Dim_Msg_For_Component_Declaration (N, Etyp, Expr);
+            end if;
          end if;
 
          --  Removal of dimensions in expression
@@ -1446,38 +1727,36 @@ 
    -------------------------------------------------
 
    procedure Analyze_Dimension_Extended_Return_Statement (N : Node_Id) is
-      Return_Ent            : constant Entity_Id :=
-                                Return_Statement_Entity (N);
-      Return_Etyp           : constant Entity_Id :=
-                                Etype (Return_Applies_To (Return_Ent));
-      Dims_Of_Return_Etyp   : constant Dimension_Type :=
-                                Dimensions_Of (Return_Etyp);
-      Return_Obj_Decls      : constant List_Id :=
-                                Return_Object_Declarations (N);
-      Dims_Of_Return_Obj_Id : Dimension_Type;
-      Return_Obj_Decl       : Node_Id;
-      Return_Obj_Id         : Entity_Id;
+      Return_Ent       : constant Entity_Id := Return_Statement_Entity (N);
+      Return_Etyp      : constant Entity_Id :=
+                           Etype (Return_Applies_To (Return_Ent));
+      Return_Obj_Decls : constant List_Id := Return_Object_Declarations (N);
+      Return_Obj_Decl  : Node_Id;
+      Return_Obj_Id    : Entity_Id;
+      Return_Obj_Typ   : Entity_Id;
 
       procedure Error_Dim_Msg_For_Extended_Return_Statement
-        (N             : Node_Id;
-         Return_Etyp   : Entity_Id;
-         Return_Obj_Id : Entity_Id);
+        (N              : Node_Id;
+         Return_Etyp    : Entity_Id;
+         Return_Obj_Typ : Entity_Id);
       --  Error using Error_Msg_N at node N. Output the dimensions of the
-      --  returned type Return_Etyp and the returned object Return_Obj_Id of N.
+      --  returned type Return_Etyp and the returned object type Return_Obj_Typ
+      --  of N.
 
       -------------------------------------------------
       -- Error_Dim_Msg_For_Extended_Return_Statement --
       -------------------------------------------------
 
       procedure Error_Dim_Msg_For_Extended_Return_Statement
-        (N             : Node_Id;
-         Return_Etyp   : Entity_Id;
-         Return_Obj_Id : Entity_Id)
+        (N              : Node_Id;
+         Return_Etyp    : Entity_Id;
+         Return_Obj_Typ : Entity_Id)
       is
       begin
          Error_Msg_N ("dimensions mismatch in extended return statement", N);
-         Error_Msg_N ("\returned type " & Dimensions_Msg_Of (Return_Etyp), N);
-         Error_Msg_N ("\returned object " & Dimensions_Msg_Of (Return_Obj_Id),
+         Error_Msg_N ("\expected dimension " &
+                      Dimensions_Msg_Of (Return_Etyp) & ", found " &
+                      Dimensions_Msg_Of (Return_Obj_Typ),
                       N);
       end Error_Dim_Msg_For_Extended_Return_Statement;
 
@@ -1486,16 +1765,21 @@ 
    begin
       if Present (Return_Obj_Decls) then
          Return_Obj_Decl := First (Return_Obj_Decls);
+
          while Present (Return_Obj_Decl) loop
             if Nkind (Return_Obj_Decl) = N_Object_Declaration then
-               Return_Obj_Id := Defining_Identifier (Return_Obj_Decl);
+               Return_Obj_Id  := Defining_Identifier (Return_Obj_Decl);
 
                if Is_Return_Object (Return_Obj_Id) then
-                  Dims_Of_Return_Obj_Id := Dimensions_Of (Return_Obj_Id);
+                  Return_Obj_Typ := Etype (Return_Obj_Id);
 
-                  if Dims_Of_Return_Etyp /= Dims_Of_Return_Obj_Id then
+                  --  Issue an error message if dimensions mismatch
+
+                  if Dimensions_Of (Return_Etyp) /=
+                       Dimensions_Of (Return_Obj_Typ)
+                  then
                      Error_Dim_Msg_For_Extended_Return_Statement
-                       (N, Return_Etyp, Return_Obj_Id);
+                       (N, Return_Etyp, Return_Obj_Typ);
                      return;
                   end if;
                end if;
@@ -1506,107 +1790,122 @@ 
       end if;
    end Analyze_Dimension_Extended_Return_Statement;
 
-   -------------------------------------
-   -- Analyze_Dimension_Function_Call --
-   -------------------------------------
+   -----------------------------------------------------
+   -- Analyze_Dimension_Extension_Or_Record_Aggregate --
+   -----------------------------------------------------
 
-   --  Propagate the dimensions from the returned type to the call node. Note
-   --  that there is a special treatment for elementary function calls. Indeed
-   --  for Sqrt call, the resulting dimensions equal to half the dimensions of
-   --  the actual, and for other elementary calls, this routine check that
-   --  every actuals are dimensionless.
+   procedure Analyze_Dimension_Extension_Or_Record_Aggregate (N : Node_Id) is
+      Comp     : Node_Id := First (Component_Associations (N));
+      Comp_Id  : Entity_Id;
+      Comp_Typ : Entity_Id;
+      Expr     : Node_Id;
 
-   procedure Analyze_Dimension_Function_Call (N : Node_Id) is
-      Actuals        : constant List_Id := Parameter_Associations (N);
-      Name_Call      : constant Node_Id := Name (N);
-      Actual         : Node_Id;
-      Dims_Of_Actual : Dimension_Type;
-      Dims_Of_Call   : Dimension_Type;
-      Ent            : Entity_Id;
+      Error_Detected : Boolean := False;
+      --  This flag is used in order to indicate if an error has been detected
+      --  so far by the compiler in this routine.
 
-      function Is_Elementary_Function_Entity (E : Entity_Id) return Boolean;
-      --  Given E, the original subprogram entity, return True if call is to an
-      --  elementary function (see Ada.Numerics.Generic_Elementary_Functions).
+   begin
+      --  Aspect is an Ada 2012 feature. Note that there is no need to check
+      --  dimensions for aggregates that don't come from source.
 
-      -----------------------------------
-      -- Is_Elementary_Function_Entity --
-      -----------------------------------
+      if Ada_Version < Ada_2012
+        or else not Comes_From_Source (N)
+      then
+         return;
+      end if;
 
-      function Is_Elementary_Function_Entity (E : Entity_Id) return Boolean is
-         Loc : constant Source_Ptr := Sloc (E);
+      while Present (Comp) loop
+         Comp_Id  := Entity (First (Choices (Comp)));
+         Comp_Typ := Etype (Comp_Id);
 
-      begin
-         --  Is function entity in Ada.Numerics.Generic_Elementary_Functions?
+         --  Check the component type is either a dimensioned type or a
+         --  dimensioned subtype.
 
-         return
-           Loc > No_Location
-             and then
-               Is_RTU
-                (Cunit_Entity (Get_Source_Unit (Loc)),
-                 Ada_Numerics_Generic_Elementary_Functions);
-      end Is_Elementary_Function_Entity;
+         if Has_Dimension_System (Base_Type (Comp_Typ)) then
+            Expr := Expression (Comp);
 
-   --  Start of processing for Analyze_Dimension_Function_Call
+            --  Issue an error if the dimensions of the component type and the
+            --  dimensions of the component mismatch.
 
-   begin
-      --  Look for elementary function call
+            if Dimensions_Of (Expr) /= Dimensions_Of (Comp_Typ) then
+               --  Check if an error has already been encountered so far
 
-      if Is_Entity_Name (Name_Call) then
-         Ent := Entity (Name_Call);
+               if not Error_Detected then
+                  --  Extension aggregate case
 
-         --  Get the original subprogram entity following the renaming chain
+                  if Nkind (N) = N_Extension_Aggregate then
+                     Error_Msg_N ("dimensions mismatch in extension aggregate",
+                                  N);
 
-         if Present (Alias (Ent)) then
-            Ent := Alias (Ent);
+                  --  Record aggregate case
+
+                  else
+                     Error_Msg_N ("dimensions mismatch in record aggregate",
+                                  N);
+                  end if;
+
+                  Error_Detected := True;
+               end if;
+
+               Error_Msg_N ("\expected dimension " &
+                            Dimensions_Msg_Of (Comp_Typ) & ", found " &
+                            Dimensions_Msg_Of (Expr),
+                            Comp);
+            end if;
          end if;
 
-         --  Elementary function case
+         Next (Comp);
+      end loop;
+   end Analyze_Dimension_Extension_Or_Record_Aggregate;
 
-         if Is_Elementary_Function_Entity (Ent) then
+   -------------------------------
+   -- Analyze_Dimension_Formals --
+   -------------------------------
 
-         --  Sqrt function call case
+   procedure Analyze_Dimension_Formals (N : Node_Id; Formals : List_Id) is
+      Dims_Of_Typ : Dimension_Type;
+      Formal      : Node_Id;
+      Typ         : Entity_Id;
 
-            if Chars (Ent) = Name_Sqrt then
-               Dims_Of_Call := Dimensions_Of (First (Actuals));
+   begin
+      --  Aspect is an Ada 2012 feature. Note that there is no need to check
+      --  dimensions for sub specs that don't come from source.
 
-               if Exists (Dims_Of_Call) then
-                  for Position in Dims_Of_Call'Range loop
-                     Dims_Of_Call (Position) :=
-                       Dims_Of_Call (Position) * Rational'(Numerator   => 1,
-                                                           Denominator => 2);
-                  end loop;
+      if Ada_Version < Ada_2012
+        or else not Comes_From_Source (N)
+      then
+         return;
+      end if;
 
-                  Set_Dimensions (N, Dims_Of_Call);
-               end if;
+      Formal := First (Formals);
 
-            --  All other elementary functions case. Note that every actual
-            --  here should be dimensionless.
+      while Present (Formal) loop
+         Typ         := Parameter_Type (Formal);
+         Dims_Of_Typ := Dimensions_Of  (Typ);
 
-            else
-               Actual := First (Actuals);
-               while Present (Actual) loop
-                  Dims_Of_Actual := Dimensions_Of (Actual);
+         if Exists (Dims_Of_Typ) then
+            declare
+               Expr : constant Node_Id := Expression (Formal);
 
-                  if Exists (Dims_Of_Actual) then
-                     Error_Msg_NE ("parameter of& must be dimensionless",
-                                   Actual, Name_Call);
-                     Error_Msg_N ("\parameter " & Dimensions_Msg_Of (Actual),
-                                  Actual);
-                  end if;
+            begin
+               --  Issue a warning if Expr is a numeric literal and if its
+               --  dimensions differ with the dimensions of the formal type.
 
-                  Next (Actual);
-               end loop;
-            end if;
-
-            return;
+               if Present (Expr)
+                 and then Dims_Of_Typ /= Dimensions_Of (Expr)
+                 and then Nkind_In (Original_Node (Expr),
+                                       N_Real_Literal,
+                                       N_Integer_Literal)
+               then
+                  Dim_Warning_For_Numeric_Literal (Expr, Etype (Typ));
+               end if;
+            end;
          end if;
-      end if;
 
-      --  Other cases
+         Next (Formal);
+      end loop;
+   end Analyze_Dimension_Formals;
 
-      Analyze_Dimension_Has_Etype (N);
-   end Analyze_Dimension_Function_Call;
-
    ---------------------------------
    -- Analyze_Dimension_Has_Etype --
    ---------------------------------
@@ -1691,8 +1990,10 @@ 
          Expr : Node_Id) is
       begin
          Error_Msg_N ("dimensions mismatch in object declaration", N);
-         Error_Msg_N ("\object type " & Dimensions_Msg_Of (Etyp), N);
-         Error_Msg_N ("\object expression " & Dimensions_Msg_Of (Expr), N);
+         Error_Msg_N ("\expected dimension " &
+                      Dimensions_Msg_Of (Etyp) & ", found " &
+                      Dimensions_Msg_Of (Expr),
+                      Expr);
       end Error_Dim_Msg_For_Object_Declaration;
 
    --  Start of processing for Analyze_Dimension_Object_Declaration
@@ -1703,22 +2004,29 @@ 
       if Present (Expr) then
          Dim_Of_Expr := Dimensions_Of (Expr);
 
-         --  Case when expression is not a literal and when dimensions of the
-         --  expression and of the type mismatch
+         --  Check dimensions match
 
-         if not Nkind_In (Original_Node (Expr),
+         if Dim_Of_Expr /= Dim_Of_Etyp then
+            --  Numeric literal case. Issue a warning if the object type is not
+            --  dimensionless to indicate the literal is treated as if its
+            --  dimension matches the type dimension.
+
+            if Nkind_In (Original_Node (Expr),
                              N_Real_Literal,
                              N_Integer_Literal)
-           and then Dim_Of_Expr /= Dim_Of_Etyp
-         then
-            --  Propagate the dimension from the expression to the object
-            --  entity when the object is a constant whose type is a
-            --  dimensioned type.
+            then
+               Dim_Warning_For_Numeric_Literal (Expr, Etyp);
 
-            if Constant_Present (N) and then not Exists (Dim_Of_Etyp) then
+            --  Case where the object is a constant whose type is a dimensioned
+            --  type.
+
+            elsif Constant_Present (N) and then not Exists (Dim_Of_Etyp) then
+               --  Propagate the dimension from the expression to the object
+               --  entity
+
                Set_Dimensions (Id, Dim_Of_Expr);
 
-            --  Otherwise, issue an error message
+            --  For all other cases, issue an error message
 
             else
                Error_Dim_Msg_For_Object_Declaration (N, Etyp, Expr);
@@ -1755,11 +2063,11 @@ 
          Sub_Mark     : Node_Id;
          Renamed_Name : Node_Id) is
       begin
-         Error_Msg_N ("dimensions mismatch in object renaming declaration",
-                      N);
-         Error_Msg_N ("\type " & Dimensions_Msg_Of (Sub_Mark), N);
-         Error_Msg_N ("\renamed object " & Dimensions_Msg_Of (Renamed_Name),
-                      N);
+         Error_Msg_N ("dimensions mismatch in object renaming declaration", N);
+         Error_Msg_N ("\expected dimension " &
+                      Dimensions_Msg_Of (Sub_Mark) & ", found " &
+                      Dimensions_Msg_Of (Renamed_Name),
+                      Renamed_Name);
       end Error_Dim_Msg_For_Object_Renaming_Declaration;
 
    --  Start of processing for Analyze_Dimension_Object_Renaming_Declaration
@@ -1802,8 +2110,10 @@ 
       is
       begin
          Error_Msg_N ("dimensions mismatch in return statement", N);
-         Error_Msg_N ("\returned type " & Dimensions_Msg_Of (Return_Etyp), N);
-         Error_Msg_N ("\returned expression " & Dimensions_Msg_Of (Expr), N);
+         Error_Msg_N ("\expected dimension " &
+                      Dimensions_Msg_Of (Return_Etyp) & ", found " &
+                      Dimensions_Msg_Of (Expr),
+                      Expr);
       end Error_Dim_Msg_For_Simple_Return_Statement;
 
    --  Start of processing for Analyze_Dimension_Simple_Return_Statement
@@ -1838,7 +2148,8 @@ 
             --  it cannot inherit a dimension from its subtype.
 
             if Exists (Dims_Of_Id) then
-               Error_Msg_N ("subtype& already" & Dimensions_Msg_Of (Id), N);
+               Error_Msg_N ("subtype& already" & Dimensions_Msg_Of (Id, True),
+                            N);
             else
                Set_Dimensions (Id, Dims_Of_Etyp);
                Set_Symbol (Id, Symbol_Of (Etyp));
@@ -2011,7 +2322,10 @@ 
    -- Dimensions_Msg_Of --
    -----------------------
 
-   function Dimensions_Msg_Of (N : Node_Id) return String is
+   function Dimensions_Msg_Of
+      (N                  : Node_Id;
+       Description_Needed : Boolean := False) return String
+   is
       Dims_Of_N      : constant Dimension_Type := Dimensions_Of (N);
       Dimensions_Msg : Name_Id;
       System         : System_Type;
@@ -2021,13 +2335,32 @@ 
 
       Name_Len := 0;
 
+      --  N is not dimensionless
+
       if Exists (Dims_Of_N) then
          System := System_Of (Base_Type (Etype (N)));
-         Add_Str_To_Name_Buffer ("has dimension ");
+
+         --  When Description_Needed, add to string "has dimension " before the
+         --  actual dimension.
+
+         if Description_Needed then
+            Add_Str_To_Name_Buffer ("has dimension ");
+         end if;
+
          Add_String_To_Name_Buffer
            (From_Dim_To_Str_Of_Dim_Symbols (Dims_Of_N, System, True));
+
+      --  N is dimensionless
+
+      --  When Description_Needed, return "is dimensionless"
+
+      elsif Description_Needed then
+         Add_Str_To_Name_Buffer ("is dimensionless");
+
+      --  Otherwise, return "[]"
+
       else
-         Add_Str_To_Name_Buffer ("is dimensionless");
+         Add_Str_To_Name_Buffer ("[]");
       end if;
 
       Dimensions_Msg := Name_Find;
@@ -2045,6 +2378,27 @@ 
       return Dimension_Table_Range (Key mod 511);
    end Dimension_Table_Hash;
 
+   -------------------------------------
+   -- Dim_Warning_For_Numeric_Literal --
+   -------------------------------------
+
+   procedure Dim_Warning_For_Numeric_Literal (N : Node_Id; Typ : Entity_Id) is
+   begin
+      --  Initialize name buffer
+
+      Name_Len := 0;
+
+      Add_String_To_Name_Buffer (String_From_Numeric_Literal (N));
+
+      --  Insert a blank between the literal and the symbol
+      Add_Str_To_Name_Buffer    (" ");
+
+      Add_String_To_Name_Buffer (Symbol_Of (Typ));
+
+      Error_Msg_Name_1 := Name_Find;
+      Error_Msg_N ("?assumed to be%%", N);
+   end Dim_Warning_For_Numeric_Literal;
+
    ----------------------------------------
    -- Eval_Op_Expon_For_Dimensioned_Type --
    ----------------------------------------
@@ -2243,6 +2597,11 @@ 
       return Dim /= Null_Dimension;
    end Exists;
 
+   function Exists (Str : String_Id) return Boolean is
+   begin
+      return Str /= No_String;
+   end Exists;
+
    function Exists (Sys : System_Type) return Boolean is
    begin
       return Sys /= Null_System;
@@ -2311,7 +2670,7 @@ 
       Dims_Of_Actual : Dimension_Type;
       Etyp           : Entity_Id;
       New_Str_Lit    : Node_Id := Empty;
-      System         : System_Type;
+      Symbols        : String_Id;
 
       Is_Put_Dim_Of : Boolean := False;
       --  This flag is used in order to differentiate routines Put and
@@ -2463,10 +2822,10 @@ 
             --  by the routine From_Dim_To_Str_Of_Dim_Symbols.
 
             if Exists (Dims_Of_Actual) then
-               System := System_Of (Base_Type (Etyp));
                New_Str_Lit :=
                  Make_String_Literal (Loc,
-                   From_Dim_To_Str_Of_Dim_Symbols (Dims_Of_Actual, System));
+                   From_Dim_To_Str_Of_Dim_Symbols
+                     (Dims_Of_Actual, System_Of (Base_Type (Etyp))));
 
             --  If dimensionless, the output is []
 
@@ -2481,25 +2840,24 @@ 
             --  Add the symbol as a suffix of the value if the subtype has a
             --  unit symbol or if the parameter is not dimensionless.
 
-            if Symbol_Of (Etyp) /= No_String then
+            if Exists (Symbol_Of (Etyp)) then
+               Symbols := Symbol_Of (Etyp);
+
+            else
+               Symbols := From_Dim_To_Str_Of_Unit_Symbols
+                            (Dims_Of_Actual, System_Of (Base_Type (Etyp)));
+            end if;
+
+            --  Check Symbols exists
+
+            if Exists (Symbols) then
                Start_String;
 
                --  Put a space between the value and the dimension
 
                Store_String_Char (' ');
-               Store_String_Chars (Symbol_Of (Etyp));
+               Store_String_Chars (Symbols);
                New_Str_Lit := Make_String_Literal (Loc, End_String);
-
-            --  Check that the item is not dimensionless
-
-            --  Create the new String_Literal with the new String_Id generated
-            --  by the routine From_Dim_To_Str_Of_Unit_Symbols.
-
-            elsif Exists (Dims_Of_Actual) then
-               System := System_Of (Base_Type (Etyp));
-               New_Str_Lit :=
-                 Make_String_Literal (Loc,
-                   From_Dim_To_Str_Of_Unit_Symbols (Dims_Of_Actual, System));
             end if;
          end if;
 
@@ -2672,14 +3030,16 @@ 
       First_Dim : Boolean := True;
 
    begin
+      --  Return No_String if dimensionless
+
+      if not Exists (Dims) then
+         return No_String;
+      end if;
+
       --  Initialization of the new String_Id
 
       Start_String;
 
-      --  Put a space between the value and the symbols
-
-      Store_String_Char (' ');
-
       for Position in Dimension_Type'Range loop
          Dim_Power := Dims (Position);
 
@@ -2823,6 +3183,10 @@ 
       Dims_Of_From : constant Dimension_Type := Dimensions_Of (From);
 
    begin
+      if Ada_Version < Ada_2012 then
+         return;
+      end if;
+
       --  Copy the dimension of 'From to 'To' and remove dimension of 'From'
 
       if Exists (Dims_Of_From) then
@@ -2861,26 +3225,6 @@ 
       end if;
    end Remove_Dimensions;
 
-   ------------------------------
-   -- Remove_Dimension_In_Call --
-   ------------------------------
-
-   procedure Remove_Dimension_In_Call (Call : Node_Id) is
-      Actual : Node_Id;
-
-   begin
-      if Ada_Version < Ada_2012 then
-         return;
-      end if;
-
-      Actual := First (Parameter_Associations (Call));
-
-      while Present (Actual) loop
-         Remove_Dimensions (Actual);
-         Next (Actual);
-      end loop;
-   end Remove_Dimension_In_Call;
-
    -----------------------------------
    -- Remove_Dimension_In_Statement --
    -----------------------------------
@@ -2935,13 +3279,86 @@ 
       Symbol_Table.Set (E, Val);
    end Set_Symbol;
 
+   ---------------------------------
+   -- String_From_Numeric_Literal --
+   ---------------------------------
+
+   function String_From_Numeric_Literal (N : Node_Id) return String_Id is
+      Loc     : constant Source_Ptr        := Sloc (N);
+      Sbuffer : constant Source_Buffer_Ptr :=
+                  Source_Text (Get_Source_File_Index (Loc));
+      Src_Ptr : Source_Ptr := Loc;
+      C       : Character  := Sbuffer (Src_Ptr);
+         --  Current source program character
+
+      function Belong_To_Numeric_Literal (C : Character) return Boolean;
+      --  Return True if C belongs to a numeric literal
+
+      -------------------------------
+      -- Belong_To_Numeric_Literal --
+      -------------------------------
+
+      function Belong_To_Numeric_Literal (C : Character) return Boolean is
+      begin
+         case C is
+            when '0' .. '9' |
+                 '_'        |
+                 '.'        |
+                 'e'        |
+                 '#'        |
+                 'A'        |
+                 'B'        |
+                 'C'        |
+                 'D'        |
+                 'E'        |
+                 'F'        =>
+               return True;
+
+            --  Make sure '+' or '-' is part of an exponent.
+
+            when '+'  | '-' =>
+               declare
+                  Prev_C : constant Character := Sbuffer (Src_Ptr - 1);
+               begin
+                  return Prev_C = 'e' or else Prev_C = 'E';
+               end;
+
+            --  All other character doesn't belong to a numeric literal
+
+            when others     =>
+               return False;
+         end case;
+      end Belong_To_Numeric_Literal;
+
+   --  Start of processing for String_From_Numeric_Literal
+
+   begin
+      Start_String;
+
+      while Belong_To_Numeric_Literal (C) loop
+         Store_String_Char (C);
+         Src_Ptr := Src_Ptr + 1;
+         C       := Sbuffer (Src_Ptr);
+      end loop;
+
+      return End_String;
+   end String_From_Numeric_Literal;
+
    ---------------
    -- Symbol_Of --
    ---------------
 
    function Symbol_Of (E : Entity_Id) return String_Id is
+      Subtype_Symbol : constant String_Id := Symbol_Table.Get (E);
+
    begin
-      return Symbol_Table.Get (E);
+      if Subtype_Symbol /= No_String then
+         return Subtype_Symbol;
+
+      else
+         return From_Dim_To_Str_Of_Unit_Symbols
+                  (Dimensions_Of (E), System_Of (Base_Type (E)));
+      end if;
    end Symbol_Of;
 
    -----------------------
@@ -2971,5 +3388,4 @@ 
 
       return Null_System;
    end System_Of;
-
 end Sem_Dim;
Index: sem_dim.ads
===================================================================
--- sem_dim.ads	(revision 191888)
+++ sem_dim.ads	(working copy)
@@ -108,16 +108,19 @@ 
 
    procedure Analyze_Dimension (N : Node_Id);
    --  N may denote any of the following contexts:
+   --    * aggregate
    --    * assignment statement
    --    * attribute reference
    --    * binary operator
+   --    * call
    --    * compontent declaration
    --    * extended return statement
-   --    * function call
+   --    * expanded name
    --    * identifier
    --    * indexed component
    --    * object declaration
    --    * object renaming declaration
+   --    * procedure call statement
    --    * qualified expression
    --    * selected component
    --    * simple return statement
@@ -129,6 +132,36 @@ 
    --  Depending on the context, ensure that all expressions and entities
    --  involved do not violate the rules of a system.
 
+   procedure Analyze_Dimension_Array_Aggregate
+     (N        : Node_Id;
+      Comp_Typ : Entity_Id);
+   --  Check, for each component of the array aggregate denoted by N, the
+   --  dimensions of the component expression match the dimensions of the
+   --  component type Comp_Typ.
+
+   procedure Analyze_Dimension_Call (N : Node_Id; Nam : Entity_Id);
+   --  This routine is split in two steps. Note the second step applies only to
+   --  function calls.
+   --  Step 1. Dimension checking:
+   --    * General case: check the dimensions of each actual parameter match
+   --      the dimensions of the corresponding formal parameter.
+   --    * Elementary function case: check each actual is dimensionless except
+   --      for Sqrt call.
+   --  Step 2. Dimension propagation (only for functions):
+   --    * General case: propagate the dimensions from the returned type to the
+   --      function call.
+   --    * Sqrt case: the resulting dimensions equal to half the dimensions of
+   --      the actual
+
+   procedure Analyze_Dimension_Extension_Or_Record_Aggregate (N : Node_Id);
+   --  Check, for each component of the extension or record aggregate denoted
+   --  by N, the dimensions of the component expression match the dimensions of
+   --  the component type.
+
+   procedure Analyze_Dimension_Formals (N : Node_Id; Formals : List_Id);
+   --  For sub spec N, issue a warning for each dimensioned formal with a
+   --  literal default value in the list of formals Formals.
+
    procedure Eval_Op_Expon_For_Dimensioned_Type
      (N    : Node_Id;
       Btyp : Entity_Id);
@@ -150,8 +183,8 @@ 
    --  Return True if N is a package instantiation of System.Dim.Integer_IO or
    --  of System.Dim.Float_IO.
 
-   procedure Remove_Dimension_In_Call (Call : Node_Id);
-   --  Remove the dimensions from all formal parameters of Call
+   procedure Move_Dimensions (From : Node_Id; To : Node_Id);
+   --  Copy dimension vector of From to To, delete dimension vector of From
 
    procedure Remove_Dimension_In_Statement (Stmt : Node_Id);
    --  Remove the dimensions associated with Stmt
Index: s-dmotpr.ads
===================================================================
--- s-dmotpr.ads	(revision 191888)
+++ s-dmotpr.ads	(working copy)
@@ -38,6 +38,9 @@ 
 
    --  SI prefixes for Meter
 
+   pragma Warnings (Off);
+   --  Turn off the all the dimension warnings
+
    ym  : constant Length := 1.0E-24;  -- yocto
    zm  : constant Length := 1.0E-21;  -- zepto
    am  : constant Length := 1.0E-18;  -- atto
@@ -165,4 +168,5 @@ 
    Zecd : constant Luminous_Intensity := 1.0E+21;  -- zetta
    Yocd : constant Luminous_Intensity := 1.0E+24;  -- yotta
 
+   pragma Warnings (On);
 end System.Dim.Mks.Other_Prefixes;
Index: sem_res.adb
===================================================================
--- sem_res.adb	(revision 191894)
+++ sem_res.adb	(working copy)
@@ -5888,8 +5888,11 @@ 
          end;
       end if;
 
-      Analyze_Dimension (N);
+      --  Check the dimensions of the actuals in the call. For function calls,
+      --  propagate the dimensions from the returned type to N.
 
+      Analyze_Dimension_Call (N, Nam);
+
       --  All done, evaluate call and deal with elaboration issues
 
       Eval_Call (N);
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb	(revision 191900)
+++ exp_ch6.adb	(working copy)
@@ -2392,10 +2392,6 @@ 
          Expand_Put_Call_With_Symbol (Call_Node);
       end if;
 
-      --  Remove the dimensions of every parameters in call
-
-      Remove_Dimension_In_Call (N);
-
       --  Ignore if previous error
 
       if Nkind (Call_Node) in N_Has_Etype
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb	(revision 191903)
+++ sem_ch6.adb	(working copy)
@@ -3450,6 +3450,10 @@ 
          Push_Scope (Designator);
          Process_Formals (Formals, N);
 
+         --  Check dimensions in N for formals with default expression
+
+         Analyze_Dimension_Formals (N, Formals);
+
          --  Ada 2005 (AI-345): If this is an overriding operation of an
          --  inherited interface operation, and the controlling type is
          --  a synchronized type, replace the type with its corresponding
Index: sem_ch8.adb
===================================================================
--- sem_ch8.adb	(revision 191894)
+++ sem_ch8.adb	(working copy)
@@ -577,6 +577,8 @@ 
       else
          Find_Expanded_Name (N);
       end if;
+
+      Analyze_Dimension (N);
    end Analyze_Expanded_Name;
 
    ---------------------------------------
@@ -6153,6 +6155,8 @@ 
 
          Analyze_Selected_Component (N);
       end if;
+
+      Analyze_Dimension (N);
    end Find_Selected_Component;
 
    ---------------
Index: s-dimmks.ads
===================================================================
--- s-dimmks.ads	(revision 191888)
+++ s-dimmks.ads	(working copy)
@@ -103,6 +103,9 @@ 
 
    --  SI Base units
 
+   pragma Warnings (Off);
+   --  Turn off the all the dimension warnings
+
    m   : constant Length                    := 1.0;
    kg  : constant Mass                      := 1.0;
    s   : constant Time                      := 1.0;
@@ -111,98 +114,134 @@ 
    mol : constant Amount_Of_Substance       := 1.0;
    cd  : constant Luminous_Intensity        := 1.0;
 
+   pragma Warnings (On);
+
    --  SI Derived dimensioned subtypes
 
+   subtype Absorbed_Dose is Mks_Type
+     with
+      Dimension => (Symbol => "Gy",
+        Meter =>  2,
+        Second => -2,
+        others => 0);
+
    subtype Angle is Mks_Type
      with
       Dimension => (Symbol => "rad",
         others => 0);
 
-   subtype Solid_Angle is Mks_Type
+   subtype Area is Mks_Type
      with
-      Dimension => (Symbol => "sr",
+      Dimension => (
+        Meter =>  2,
         others => 0);
 
-   subtype Frequency is Mks_Type
+   subtype Catalytic_Activity is Mks_Type
      with
-      Dimension => (Symbol => "Hz",
+      Dimension => (Symbol => "kat",
         Second => -1,
+        Mole =>   1,
         others => 0);
 
-   subtype Force is Mks_Type
+   subtype Celsius_Temperature is Mks_Type
      with
-      Dimension => (Symbol => 'N',
-        Meter =>    1,
-        Kilogram => 1,
-        Second =>  -2,
+      Dimension => (Symbol => "°C",
+        Kelvin => 1,
+        others => 0);
+
+   subtype Electric_Capacitance is Mks_Type
+     with
+      Dimension => (Symbol => 'F',
+        Meter =>    -2,
+        Kilogram => -1,
+        Second =>   4,
+        Ampere =>   2,
         others =>   0);
 
-   subtype Pressure is Mks_Type
+   subtype Electric_Charge is Mks_Type
      with
-      Dimension => (Symbol => "Pa",
-        Meter =>    -1,
-        Kilogram => 1,
-        Second =>   -2,
+      Dimension => (Symbol => 'C',
+        Second => 1,
+        Ampere => 1,
+        others => 0);
+
+   subtype Electric_Conductance is Mks_Type
+     with
+      Dimension => (Symbol => 'S',
+        Meter =>    -2,
+        Kilogram => -1,
+        Second =>   3,
+        Ampere =>   2,
         others =>   0);
 
-   subtype Energy is Mks_Type
+   subtype Electric_Potential_Difference is Mks_Type
      with
-      Dimension => (Symbol => 'J',
+      Dimension => (Symbol => 'V',
         Meter =>    2,
         Kilogram => 1,
-        Second =>   -2,
+        Second =>   -3,
+        Ampere =>   -1,
         others =>   0);
 
-   subtype Power is Mks_Type
+   subtype Electric_Resistance is Mks_Type
      with
-      Dimension => (Symbol => 'W',
+      Dimension => (Symbol => "Ω",
         Meter =>    2,
         Kilogram => 1,
         Second =>   -3,
+        Ampere =>   -2,
         others =>   0);
 
-   subtype Electric_Charge is Mks_Type
+   subtype Energy is Mks_Type
      with
-      Dimension => (Symbol => 'C',
-        Second => 1,
-        Ampere => 1,
+      Dimension => (Symbol => 'J',
+        Meter =>    2,
+        Kilogram => 1,
+        Second =>   -2,
+        others =>   0);
+
+   subtype Equivalent_Dose is Mks_Type
+     with
+      Dimension => (Symbol => "Sv",
+        Meter =>  2,
+        Second => -2,
         others => 0);
 
-   subtype Electric_Potential_Difference is Mks_Type
+   subtype Force is Mks_Type
      with
-      Dimension => (Symbol => 'V',
-        Meter =>    2,
+      Dimension => (Symbol => 'N',
+        Meter =>    1,
         Kilogram => 1,
-        Second =>   -3,
-        Ampere =>   -1,
+        Second =>  -2,
         others =>   0);
 
-   subtype Electric_Capacitance is Mks_Type
+   subtype Frequency is Mks_Type
      with
-      Dimension => (Symbol => 'F',
-        Meter =>    -2,
-        Kilogram => -1,
-        Second =>   4,
-        Ampere =>   2,
-        others =>   0);
+      Dimension => (Symbol => "Hz",
+        Second => -1,
+        others => 0);
 
-   subtype Electric_Resistance is Mks_Type
+   subtype Illuminance is Mks_Type
      with
-      Dimension => (Symbol => "Ω",
+      Dimension => (Symbol => "lx",
+        Meter =>   -2,
+        Candela => 1,
+        others =>  0);
+
+   subtype Inductance is Mks_Type
+     with
+      Dimension => (Symbol => 'H',
         Meter =>    2,
         Kilogram => 1,
-        Second =>   -3,
+        Second =>   -2,
         Ampere =>   -2,
         others =>   0);
 
-   subtype Electric_Conductance is Mks_Type
+   subtype Luminous_Flux is Mks_Type
      with
-      Dimension => (Symbol => 'S',
-        Meter =>    -2,
-        Kilogram => -1,
-        Second =>   3,
-        Ampere =>   2,
-        others =>   0);
+      Dimension => (Symbol => "lm",
+        Candela => 1,
+        others =>  0);
 
    subtype Magnetic_Flux is Mks_Type
      with
@@ -221,61 +260,49 @@ 
         Ampere =>   -1,
         others =>   0);
 
-   subtype Inductance is Mks_Type
+   subtype Power is Mks_Type
      with
-      Dimension => (Symbol => 'H',
+      Dimension => (Symbol => 'W',
         Meter =>    2,
         Kilogram => 1,
-        Second =>   -2,
-        Ampere =>   -2,
+        Second =>   -3,
         others =>   0);
 
-   subtype Celsius_Temperature is Mks_Type
+   subtype Pressure is Mks_Type
      with
-      Dimension => (Symbol => "°C",
-        Kelvin => 1,
-        others => 0);
+      Dimension => (Symbol => "Pa",
+        Meter =>    -1,
+        Kilogram => 1,
+        Second =>   -2,
+        others =>   0);
 
-   subtype Luminous_Flux is Mks_Type
-     with
-      Dimension => (Symbol => "lm",
-        Candela => 1,
-        others =>  0);
-
-   subtype Illuminance is Mks_Type
-     with
-      Dimension => (Symbol => "lx",
-        Meter =>   -2,
-        Candela => 1,
-        others =>  0);
-
    subtype Radioactivity is Mks_Type
      with
       Dimension => (Symbol => "Bq",
         Second => -1,
         others => 0);
 
-   subtype Absorbed_Dose is Mks_Type
+   subtype Solid_Angle is Mks_Type
      with
-      Dimension => (Symbol => "Gy",
-        Meter =>  2,
-        Second => -2,
+      Dimension => (Symbol => "sr",
         others => 0);
 
-   subtype Equivalent_Dose is Mks_Type
+   subtype Speed is Mks_Type
      with
-      Dimension => (Symbol => "Sv",
-        Meter =>  2,
-        Second => -2,
+      Dimension => (
+        Meter =>  1,
+        Second => -1,
         others => 0);
 
-   subtype Catalytic_Activity is Mks_Type
+   subtype Volume is Mks_Type
      with
-      Dimension => (Symbol => "kat",
-        Second => -1,
-        Mole =>   1,
+      Dimension => (
+        Meter =>  3,
         others => 0);
 
+   pragma Warnings (Off);
+   --  Turn off the all the dimension warnings
+
    rad : constant Angle                         := 1.0;
    sr  : constant Solid_Angle                   := 1.0;
    Hz  : constant Frequency                     := 1.0;
@@ -349,4 +376,5 @@ 
    kA  : constant Electric_Current := 1.0E+03;  -- kilo
    MeA : constant Electric_Current := 1.0E+06;  -- mega
 
+   pragma Warnings (On);
 end System.Dim.Mks;