sem_ch3.adb (Build_Derived_Record_Type): Accept statically matching constraint expres...

    gcc/ada/
	* sem_ch3.adb (Build_Derived_Record_Type): Accept statically matching
	constraint expressions.

    gcc/testsuite/
	* gnat.dg/specs/statically_matching.ads: New.

From-SVN: r135230

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 6431d93c4a83119084f4612bbef2efbb0b9e68ec..5330ee5308379775b5257cfafc24f3e810f140d6 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,13 +1,19 @@
+2008-05-12  Samuel Tardieu  <sam@rfc1149.net>
+            Ed Schonberg <schonberg@adacore.com>
+
+       * sem_ch3.adb (Build_Derived_Record_Type): Accept statically matching
+       constraint expressions.
+
 2008-05-12  Tomas Bily  <tbily@suse.cz>
 
-        * utils2.c (known_alignment, contains_save_expr_p)
-        (gnat_mark_addressable): Use CASE_CONVERT.
-        * decl.c (annotate_value): Likewise.
-        * trans.c (maybe_stabilize_reference): Likewise.
-        * utils2.c (build_binary_op): Use CONVERT_EXPR_P.
-        * utils.c (rest_of_record_type_compilation): Likewise.
-        * trans.c (protect_multiple_eval, Attribute_to_gnu)
-        (protect_multiple_eval): Likewise.
+       * utils2.c (known_alignment, contains_save_expr_p)
+       (gnat_mark_addressable): Use CASE_CONVERT.
+       * decl.c (annotate_value): Likewise.
+       * trans.c (maybe_stabilize_reference): Likewise.
+       * utils2.c (build_binary_op): Use CONVERT_EXPR_P.
+       * utils.c (rest_of_record_type_compilation): Likewise.
+       * trans.c (protect_multiple_eval, Attribute_to_gnu)
+       (protect_multiple_eval): Likewise.
 
 2008-05-08  Andreas Schwab  <schwab@suse.de>
 

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index d050d1b0505ba33166e75b060f8d43b18f31f5c7..dd08710e37e97f684e98f0ef9935ce5002375f9f 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -6268,8 +6268,8 @@ package body Sem_Ch3 is
               and then Has_Private_Declaration (Derived_Type)
               and then Present (Discriminant_Constraint (Derived_Type))
             then
-               --  Verify that constraints of the full view conform to those
-               --  given in partial view.
+               --  Verify that constraints of the full view statically match
+               --  those given in the partial view.
 
                declare
                   C1, C2 : Elmt_Id;
@@ -6278,9 +6278,18 @@ package body Sem_Ch3 is
                   C1 := First_Elmt (New_Discrs);
                   C2 := First_Elmt (Discriminant_Constraint (Derived_Type));
                   while Present (C1) and then Present (C2) loop
-                     if not
-                       Fully_Conformant_Expressions (Node (C1), Node (C2))
+
+                     if Fully_Conformant_Expressions (Node (C1), Node (C2))
+                       or else
+                     (Is_OK_Static_Expression (Node (C1))
+                        and then
+                      Is_OK_Static_Expression (Node (C2))
+                        and then
+                      Expr_Value (Node (C1)) = Expr_Value (Node (C2)))
                      then
+                        null;
+
+                     else
                         Error_Msg_N (
                           "constraint not conformant to previous declaration",
                              Node (C1));

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 755d6832a89fc623ac424c6394882bc543669353..b9de6a88adbcca6a3966155c30f35a29a1cbac50 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2008-05-12  Samuel Tardieu  <sam@rfc1149.net>
+
+       * gnat.dg/specs/statically_matching.ads: New.
+
 2008-05-12  H.J. Lu  <hongjiu.lu@intel.com>
 
        * gcc.target/i386/sse2-set-epi32-1.c: New.

diff --git a/gcc/testsuite/gnat.dg/statically_matching.ads b/gcc/testsuite/gnat.dg/statically_matching.ads
new file mode 100644 (file)
index 0000000..de2ba1b
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/statically_matching.ads
@@ -0,0 +1,7 @@
+package Statically_Matching is
+   type T1(b: boolean) is tagged null record;
+   type T2 is new T1(b => false) with private;
+private
+   F: constant boolean := false;
+   type T2 is new T1(b => F) with null record;  -- OK
+end Statically_Matching;