re PR ada/22559 (Bug box, Program_Error at sinput.adb:404, derived fixed-point type)

    gcc/ada/
	PR ada/22559
	* sem_ch3.adb (Build_Derived_Numeric_Type): Do not set RM_Size on
	a derived ordinary fixed point type.

	* sem_ch13.adb (Analyze_Attribute_Definition_Clause): Recompute
	RM_Size when a Small clause is found.

    gcc/testsuite/
	PR ada/22559
	* gnat.dg/specs/delta_small.ads: New test.

From-SVN: r130498

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c763515..b201afb 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -22,6 +22,13 @@
        Signal an error when attribute argument is a fixed-point value of
        an unknown type.
 
+       PR ada/22559
+       * sem_ch3.adb (Build_Derived_Numeric_Type): Do not set RM_Size on
+       a derived ordinary fixed point type.
+
+       * sem_ch13.adb (Analyze_Attribute_Definition_Clause): Recompute
+       RM_Size when a Small clause is found.
+
 2007-11-26  Andreas Krebbel  <krebbel1@de.ibm.com>
 
         PR 34081/C++

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index df61a8e..18670d3 100644 (file)
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -29,6 +29,7 @@ with Einfo;    use Einfo;
 with Errout;   use Errout;
 with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
+with Layout;   use Layout;
 with Lib;      use Lib;
 with Lib.Xref; use Lib.Xref;
 with Namet;    use Namet;
@@ -1375,6 +1376,7 @@ package body Sem_Ch13 is
                Set_Has_Small_Clause (U_Ent);
                Set_Has_Small_Clause (Implicit_Base);
                Set_Has_Non_Standard_Rep (Implicit_Base);
+               Set_Discrete_RM_Size (U_Ent);
             end if;
          end Small;
 

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 6bddb20..5c61d00 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -4950,11 +4950,12 @@ package body Sem_Ch3 is
       Set_Etype          (Implicit_Base, Parent_Base);
       Set_Ekind          (Implicit_Base, Ekind          (Parent_Base));
       Set_Size_Info      (Implicit_Base,                 Parent_Base);
-      Set_RM_Size        (Implicit_Base, RM_Size        (Parent_Base));
       Set_First_Rep_Item (Implicit_Base, First_Rep_Item (Parent_Base));
       Set_Parent         (Implicit_Base, Parent (Derived_Type));
 
-      if Is_Discrete_Or_Fixed_Point_Type (Parent_Base) then
+      if Is_Discrete_Type (Parent_Base) or else
+        Is_Decimal_Fixed_Point_Type (Parent_Base)
+      then
          Set_RM_Size (Implicit_Base, RM_Size (Parent_Base));
       end if;
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 95b437b..52ceea2 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -9,6 +9,9 @@
        PR ada/32792
        * gnat.dg/specs/integer_value.ads: New test.
 
+       PR ada/22559
+       * gnat.dg/specs/delta_small.ads: New test.
+
 2007-11-28  Jakub Jelinek  <jakub@redhat.com>
 
        PR tree-optimization/34140

diff --git a/gcc/testsuite/gnat.dg/specs/delta_small.ads b/gcc/testsuite/gnat.dg/specs/delta_small.ads
new file mode 100644 (file)
index 0000000..3ff7426
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/delta_small.ads
@@ -0,0 +1,9 @@
+-- { dg-do compile }
+
+package Delta_Small is
+   type T is delta 0.1 range -0.8 .. 0.8;
+   for T'Small use 0.1;
+   for T'Size use 4;
+   type T2 is new T range -0.4 .. 0.4;
+   for T2'Small use 0.0625;
+end Delta_Small;