From ff69f95af086f0041be775afb527e3b98f9e8bf6 Mon Sep 17 00:00:00 2001
From: Robert Dewar <dewar@adacore.com>
Date: Wed, 8 Apr 2009 14:25:35 +0000
Subject: [PATCH] sem_cat.adb (Check_Categorization_Dependencies): Handle
 Preelaborate properly in the presence of Remote_Types or...

2009-04-08  Robert Dewar  <dewar@adacore.com>

	* sem_cat.adb (Check_Categorization_Dependencies): Handle Preelaborate
	properly in the presence of Remote_Types or Remote_Call_Interface.

	* sem_util.adb: Add comment.

From-SVN: r145739
---
 gcc/ada/ChangeLog    |   7 +++
 gcc/ada/sem_cat.adb  | 113 +++++++++++++++++++++++--------------------
 gcc/ada/sem_util.adb |   5 ++
 3 files changed, 72 insertions(+), 53 deletions(-)

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d844d08cedb..f9afe51cae9 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2009-04-08  Robert Dewar  <dewar@adacore.com>
+
+	* sem_cat.adb (Check_Categorization_Dependencies): Handle Preelaborate
+	properly in the presence of Remote_Types or Remote_Call_Interface.
+
+	* sem_util.adb: Add comment.
+
 2009-04-08  Robert Dewar  <dewar@adacore.com>
 
 	* ug_words: Add /ASSUME_VALID for -gnatB
diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb
index 03461d169cd..76f5f5e1c4d 100644
--- a/gcc/ada/sem_cat.adb
+++ b/gcc/ada/sem_cat.adb
@@ -113,22 +113,18 @@ package body Sem_Cat is
       Info_Node       : Node_Id;
       Is_Subunit      : Boolean)
    is
-      N : constant Node_Id := Info_Node;
+      N   : constant Node_Id := Info_Node;
+      Err : Boolean;
 
       --  Here we define an enumeration type to represent categorization types,
       --  ordered so that a unit with a given categorization can only WITH
       --  units with lower or equal categorization type.
 
-      --  Note that we take advantage of E.2(14) to define a category
-      --  Preelaborated and treat pragma Preelaborate as a categorization
-      --  pragma that defines that category.
-
       type Categorization is
         (Pure,
          Shared_Passive,
          Remote_Types,
          Remote_Call_Interface,
-         Preelaborated,
          Normal);
 
       function Get_Categorization (E : Entity_Id) return Categorization;
@@ -165,9 +161,6 @@ package body Sem_Cat is
          elsif Is_Remote_Call_Interface (E) then
             return Remote_Call_Interface;
 
-         elsif Is_Preelaborated (E) then
-            return Preelaborated;
-
          else
             return Normal;
          end if;
@@ -186,73 +179,87 @@ package body Sem_Cat is
          return;
       end if;
 
-      Unit_Category := Get_Categorization (Unit_Entity);
-      With_Category := Get_Categorization (Depended_Entity);
+      --  First check 10.2.1 (11/1) rules on preelaborate packages
 
-      --  These messages are warnings in GNAT mode, to allow it to be
-      --  judiciously turned off. Otherwise it is a real error.
+      if Is_Preelaborated (Unit_Entity)
+        and then not Is_Preelaborated (Depended_Entity)
+        and then not Is_Pure (Depended_Entity)
+      then
+         Err := True;
+      else
+         Err := False;
+      end if;
 
-      Error_Msg_Warn := GNAT_Mode;
+      --  Check categorization rules of RM E.2(5)
 
-      --  Check for possible error
+      Unit_Category := Get_Categorization (Unit_Entity);
+      With_Category := Get_Categorization (Depended_Entity);
 
       if With_Category > Unit_Category then
 
          --  Special case: Remote_Types and Remote_Call_Interface are allowed
-         --  with anything in the package body, per (RM E.2(5)).
+         --  to WITH anything in the package body, per (RM E.2(5)).
 
          if (Unit_Category = Remote_Types
                or else Unit_Category = Remote_Call_Interface)
            and then In_Package_Body (Unit_Entity)
          then
             null;
+         else
+            Err := True;
+         end if;
+      end if;
 
-         --  Here we have an error
+      --  Here if we have an error
 
-         else
-            --  Don't give error if main unit is not an internal unit, and the
-            --  unit generating the message is an internal unit. This is the
-            --  situation in which such messages would be ignored in any case,
-            --  so it is convenient not to generate them (since it causes
-            --  annoying interference with debugging).
-
-            if Is_Internal_File_Name (Unit_File_Name (Current_Sem_Unit))
-              and then not Is_Internal_File_Name (Unit_File_Name (Main_Unit))
-            then
-               return;
+      if Err then
 
-            --  Subunit case
+         --  These messages are warnings in GNAT mode, to allow it to be
+         --  judiciously turned off. Otherwise it is a real error.
 
-            elsif Is_Subunit then
-               Error_Msg_NE
-                 ("<subunit cannot depend on& " &
-                  "(parent has wrong categorization)", N, Depended_Entity);
+         Error_Msg_Warn := GNAT_Mode;
 
-            --  Normal unit, not subunit
+         --  Don't give error if main unit is not an internal unit, and the
+         --  unit generating the message is an internal unit. This is the
+         --  situation in which such messages would be ignored in any case,
+         --  so it is convenient not to generate them (since it causes
+         --  annoying interference with debugging).
 
-            else
-               Error_Msg_NE
-                 ("<cannot depend on& " &
-                  "(wrong categorization)", N, Depended_Entity);
-            end if;
+         if Is_Internal_File_Name (Unit_File_Name (Current_Sem_Unit))
+           and then not Is_Internal_File_Name (Unit_File_Name (Main_Unit))
+         then
+            return;
 
-            --  Add further explanation for common cases
+         --  Subunit case
 
-            case Unit_Category is
-               when Pure =>
-                  Error_Msg_NE
-                    ("\<pure unit cannot depend on non-pure unit",
-                    N, Depended_Entity);
+         elsif Is_Subunit then
+            Error_Msg_NE
+              ("<subunit cannot depend on& " &
+               "(parent has wrong categorization)", N, Depended_Entity);
 
-               when Preelaborated =>
-                  Error_Msg_NE
-                    ("\<preelaborated unit cannot depend on " &
-                     "non-preelaborated unit",
-                     N, Depended_Entity);
+         --  Normal unit, not subunit
 
-               when others =>
-                  null;
-            end case;
+         else
+            Error_Msg_NE
+              ("<cannot depend on& " &
+               "(wrong categorization)", N, Depended_Entity);
+         end if;
+
+         --  Add further explanation for Pure/Preelaborate common cases
+
+         if Unit_Category = Pure then
+            Error_Msg_NE
+              ("\<pure unit cannot depend on non-pure unit",
+               N, Depended_Entity);
+
+         elsif Is_Preelaborated (Unit_Entity)
+           and then not Is_Preelaborated (Depended_Entity)
+           and then not Is_Pure (Depended_Entity)
+         then
+            Error_Msg_NE
+              ("\<preelaborated unit cannot depend on "
+               & "non-preelaborated unit",
+               N, Depended_Entity);
          end if;
       end if;
    end Check_Categorization_Dependencies;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 9f43f2f7315..4876303f0a0 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -6802,6 +6802,11 @@ package body Sem_Util is
         and then Present (Etype (Orig_Node))
         and then Is_Access_Type (Etype (Orig_Node))
       then
+         --  Note that if the prefix is an explicit dereference that does not
+         --  come from source, we must check for a rewritten function call in
+         --  prefixed notation before other forms of rewriting, to prevent a
+         --  compiler crash.
+
          return
            (Nkind (Orig_Node) = N_Function_Call
              and then not Is_Access_Constant (Etype (Prefix (N))))
-- 
2.30.2