sem_dim.adb: Minor error message change.
authorRobert Dewar <dewar@adacore.com>
Mon, 8 Jul 2013 07:57:16 +0000 (07:57 +0000)
committerArnaud Charlet <charlet@gcc.gnu.org>
Mon, 8 Jul 2013 07:57:16 +0000 (09:57 +0200)
2013-07-08  Robert Dewar  <dewar@adacore.com>

* sem_dim.adb: Minor error message change.
* freeze.adb (Freeze_Entity, array type case): Extend handling
of Implicit_Packing to handle multi-dimensional array case.
* gnat_rm.texi: Update doc on Implicit_Packing.

From-SVN: r200762

gcc/ada/ChangeLog
gcc/ada/freeze.adb
gcc/ada/gnat_rm.texi
gcc/ada/sem_dim.adb

index 20c35fa..93f4b78 100644 (file)
@@ -1,5 +1,12 @@
 2013-07-08  Robert Dewar  <dewar@adacore.com>
 
+       * sem_dim.adb: Minor error message change.
+       * freeze.adb (Freeze_Entity, array type case): Extend handling
+       of Implicit_Packing to handle multi-dimensional array case.
+       * gnat_rm.texi: Update doc on Implicit_Packing.
+
+2013-07-08  Robert Dewar  <dewar@adacore.com>
+
        * exp_ch4.adb: Minor reformatting.
 
 2013-07-08  Ed Schonberg  <schonberg@adacore.com>
index 81a9359..43720a9 100644 (file)
@@ -3413,20 +3413,31 @@ package body Freeze is
 
             --  Before we do anything else, a specialized test for the case of
             --  a size given for an array where the array needs to be packed,
-            --  but was not so the size cannot be honored. This would of course
-            --  be caught by the backend, and indeed we don't catch all cases.
-            --  The point is that we can give a better error message in those
-            --  cases that we do catch with the circuitry here. Also if pragma
-            --  Implicit_Packing is set, this is where the packing occurs.
-
-            --  The reason we do this so early is that the processing in the
-            --  automatic packing case affects the layout of the base type, so
-            --  it must be done before we freeze the base type.
+            --  but was not so the size cannot be honored. This is the case
+            --  where implicit packing may apply. The reason we do this so
+            --  early is that if we have implicit packing, the lagout of the
+            --  base type is affected, so we must do this before we freeze
+            --  the base type.
+
+            --  We could do this processing only if implicit packing is enabled
+            --  since in all other cases, the error would be caught by the back
+            --  end. However, we choose to do the check even if we do not have
+            --  implicit packingh enabled, since this allows us to give a more
+            --  useful error message (advising the use of pack or the pragma).
 
             if Is_Array_Type (E) then
                declare
-                  Lo, Hi : Node_Id;
-                  Ctyp   : constant Entity_Id := Component_Type (E);
+                  Ctyp : constant Entity_Id := Component_Type (E);
+                  Rsiz : constant Uint      := RM_Size (Ctyp);
+                  SZ   : constant Node_Id   := Size_Clause (E);
+                  Btyp : constant Entity_Id := Base_Type (E);
+
+                  Lo   : Node_Id;
+                  Hi   : Node_Id;
+                  Indx : Node_Id;
+
+                  Num_Elmts : Uint;
+                  --  Number of elements in array
 
                begin
                   --  Check enabling conditions. These are straightforward
@@ -3441,87 +3452,90 @@ package body Freeze is
                   --  a chance to freeze the base type (and it is that freeze
                   --  action that causes stuff to be inherited).
 
-                  if Present (Size_Clause (E))
+                  if Has_Size_Clause (E)
                     and then Known_Static_RM_Size (E)
                     and then not Is_Packed (E)
                     and then not Has_Pragma_Pack (E)
-                    and then Number_Dimensions (E) = 1
                     and then not Has_Component_Size_Clause (E)
                     and then Known_Static_RM_Size (Ctyp)
+                    and then RM_Size (Ctyp) < 64
                     and then not Is_Limited_Composite (E)
                     and then not Is_Packed (Root_Type (E))
                     and then not Has_Component_Size_Clause (Root_Type (E))
                     and then not (CodePeer_Mode or SPARK_Mode)
                   then
-                     Get_Index_Bounds (First_Index (E), Lo, Hi);
+                     --  Compute number of elements in array
 
-                     if Compile_Time_Known_Value (Lo)
-                       and then Compile_Time_Known_Value (Hi)
-                       and then Known_Static_RM_Size (Ctyp)
-                       and then RM_Size (Ctyp) < 64
-                     then
-                        declare
-                           Lov  : constant Uint      := Expr_Value (Lo);
-                           Hiv  : constant Uint      := Expr_Value (Hi);
-                           Len  : constant Uint      := UI_Max
-                                                         (Uint_0,
-                                                          Hiv - Lov + 1);
-                           Rsiz : constant Uint      := RM_Size (Ctyp);
-                           SZ   : constant Node_Id   := Size_Clause (E);
-                           Btyp : constant Entity_Id := Base_Type (E);
-
-                        --  What we are looking for here is the situation where
-                        --  the RM_Size given would be exactly right if there
-                        --  was a pragma Pack (resulting in the component size
-                        --  being the same as the RM_Size). Furthermore, the
-                        --  component type size must be an odd size (not a
-                        --  multiple of storage unit). If the component RM size
-                        --  is an exact number of storage units that is a power
-                        --  of two, the array is not packed and has a standard
-                        --  representation.
+                     Num_Elmts := Uint_1;
+                     Indx := First_Index (E);
+                     while Present (Indx) loop
+                        Get_Index_Bounds (Indx, Lo, Hi);
 
-                        begin
-                           if RM_Size (E) = Len * Rsiz
-                             and then Rsiz mod System_Storage_Unit /= 0
-                           then
-                              --  For implicit packing mode, just set the
-                              --  component size silently.
+                        if not (Compile_Time_Known_Value (Lo)
+                                  and then
+                                Compile_Time_Known_Value (Hi))
+                        then
+                           goto No_Implicit_Packing;
+                        end if;
+
+                        Num_Elmts :=
+                          Num_Elmts *
+                            UI_Max (Uint_0,
+                                    Expr_Value (Hi) - Expr_Value (Lo) + 1);
+                        Next_Index (Indx);
+                     end loop;
 
-                              if Implicit_Packing then
-                                 Set_Component_Size       (Btyp, Rsiz);
-                                 Set_Is_Bit_Packed_Array  (Btyp);
-                                 Set_Is_Packed            (Btyp);
-                                 Set_Has_Non_Standard_Rep (Btyp);
+                     --  What we are looking for here is the situation where
+                     --  the RM_Size given would be exactly right if there was
+                     --  a pragma Pack (resulting in the component size being
+                     --  the same as the RM_Size). Furthermore, the component
+                     --  type size must be an odd size (not a multiple of
+                     --  storage unit). If the component RM size is an exact
+                     --  number of storage units that is a power of two, the
+                     --  array is not packed and has a standard representation.
+
+                     if RM_Size (E) = Num_Elmts * Rsiz
+                       and then Rsiz mod System_Storage_Unit /= 0
+                     then
+                        --  For implicit packing mode, just set the component
+                        --  size silently.
 
-                              --  Otherwise give an error message
+                        if Implicit_Packing then
+                           Set_Component_Size       (Btyp, Rsiz);
+                           Set_Is_Bit_Packed_Array  (Btyp);
+                           Set_Is_Packed            (Btyp);
+                           Set_Has_Non_Standard_Rep (Btyp);
 
-                              else
-                                 Error_Msg_NE
-                                   ("size given for& too small", SZ, E);
-                                 Error_Msg_N -- CODEFIX
-                                   ("\use explicit pragma Pack "
-                                    & "or use pragma Implicit_Packing", SZ);
-                              end if;
+                           --  Otherwise give an error message
 
-                           elsif RM_Size (E) = Len * Rsiz
-                             and then Implicit_Packing
-                             and then
-                               (Rsiz / System_Storage_Unit = 1
-                                 or else Rsiz / System_Storage_Unit = 2
-                                 or else Rsiz / System_Storage_Unit = 4)
-                           then
+                        else
+                           Error_Msg_NE
+                             ("size given for& too small", SZ, E);
+                           Error_Msg_N -- CODEFIX
+                             ("\use explicit pragma Pack "
+                              & "or use pragma Implicit_Packing", SZ);
+                        end if;
 
-                              --  Not a packed array, but indicate the desired
-                              --  component size, for the back-end.
+                     elsif RM_Size (E) = Num_Elmts * Rsiz
+                       and then Implicit_Packing
+                       and then
+                         (Rsiz / System_Storage_Unit = 1
+                            or else
+                          Rsiz / System_Storage_Unit = 2
+                            or else
+                          Rsiz / System_Storage_Unit = 4)
+                     then
+                        --  Not a packed array, but indicate the desired
+                        --  component size, for the back-end.
 
-                              Set_Component_Size (Btyp, Rsiz);
-                           end if;
-                        end;
+                        Set_Component_Size (Btyp, Rsiz);
                      end if;
                   end if;
                end;
             end if;
 
+            <<No_Implicit_Packing>>
+
             --  If ancestor subtype present, freeze that first. Note that this
             --  will also get the base type frozen. Need RM reference ???
 
index 3602ec2..11b6bb6 100644 (file)
@@ -3255,8 +3255,10 @@ of the configuration pragma Implicit_Packing, then the Size clause in this
 and similar examples will cause implicit packing and thus be accepted. For
 this implicit packing to occur, the type in question must be an array of small
 components whose size is known at compile time, and the Size clause must
-specify the exact size that corresponds to the length of the array multiplied
-by the size in bits of the component type.
+specify the exact size that corresponds to the number of elements in the array
+multiplied by the size in bits of the component type (both single and
+multi-dimensioned arrays can be controlled with this pragma).
+
 @cindex Array packing
 
 Similarly, the following example shows the use in the record case
index 1f91d96..79c1e15 100644 (file)
@@ -1409,7 +1409,7 @@ package body Sem_Dim is
                if L_Has_Dimensions then
                   if not Compile_Time_Known_Value (R) then
                      Error_Msg_N ("exponent of dimensioned operand must be " &
-                                  "known at compile-time", N);
+                                  "known at compile time", N);
                   end if;
 
                   declare