sem_util.adb: Minor refactoring.

2017-04-25  Yannick Moy  <moy@adacore.com>

	* sem_util.adb: Minor refactoring.
	* freeze.adb (Freeze_Record_Type): Fix checking of SPARK RM 7.1.3(5).

From-SVN: r247211

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c13e016c5518ed73c78aa4582a64477e04a3aca2..8edaf572cc37c66ef199150904336cac8f0ce462 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2017-04-25  Yannick Moy  <moy@adacore.com>
+
+       * sem_util.adb: Minor refactoring.
+       * freeze.adb (Freeze_Record_Type): Fix checking of SPARK RM 7.1.3(5).
+
 2017-04-25  Claire Dross  <dross@adacore.com>
 
        * sem_prag.adb (Collect_Inherited_Class_Wide_Conditions): Go to

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 523040e01704d66ce3db00cccf8080e74c2a00a5..7cfa2955d8e45e3d999f7eee330a9dff869b3ec5 100644 (file)
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -4625,9 +4625,11 @@ package body Freeze is
             if Is_Effectively_Volatile (Rec) then
 
                --  A discriminated type cannot be effectively volatile
-               --  (SPARK RM C.6(4)).
+               --  (SPARK RM 7.1.3(5)).
 
-               if Has_Discriminants (Rec) then
+               if Has_Discriminants (Rec)
+                 and then not Is_Protected_Type (Rec)
+               then
                   Error_Msg_N ("discriminated type & cannot be volatile", Rec);
 
                --  A tagged type cannot be effectively volatile
@@ -4638,7 +4640,7 @@ package body Freeze is
                end if;
 
             --  A non-effectively volatile record type cannot contain
-            --  effectively volatile components (SPARK RM C.6(2)).
+            --  effectively volatile components (SPARK RM 7.1.3(6)).
 
             else
                Comp := First_Component (Rec);

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 1cae279da0bee166dc8d35f1401d68430f7e0396..0c00fe25f5cbd6cb9b76c3a4f1ed72e531e0c1da 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -12808,14 +12808,18 @@ package body Sem_Util is
             declare
                Anc : Entity_Id := Base_Type (Id);
             begin
-               if Ekind (Anc) in Private_Kind then
+               if Is_Private_Type (Anc) then
                   Anc := Full_View (Anc);
                end if;
 
+               --  Test for presence of ancestor, as the full view of a private
+               --  type may be missing in case of error.
+
                return
                  Has_Volatile_Components (Id)
                    or else
-                 Is_Effectively_Volatile (Component_Type (Anc));
+                 (Present (Anc)
+                   and then Is_Effectively_Volatile (Component_Type (Anc)));
             end;
 
          --  A protected type is always volatile