From ff69f95af086f0041be775afb527e3b98f9e8bf6 Mon Sep 17 00:00:00 2001 From: Robert Dewar 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 * 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 | 123 +++++++++++++++++++++++-------------------- gcc/ada/sem_util.adb | 5 ++ 3 files changed, 77 insertions(+), 58 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 + + * 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 * 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; + -- First check 10.2.1 (11/1) rules on preelaborate packages + + 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; + + -- Check categorization rules of RM E.2(5) + Unit_Category := Get_Categorization (Unit_Entity); With_Category := Get_Categorization (Depended_Entity); - -- These messages are warnings in GNAT mode, to allow it to be - -- judiciously turned off. Otherwise it is a real error. - - Error_Msg_Warn := GNAT_Mode; - - -- Check for possible error - 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 + + if Err then + + -- These messages are warnings in GNAT mode, to allow it to be + -- judiciously turned off. Otherwise it is a real error. + + Error_Msg_Warn := GNAT_Mode; + + -- 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; + + -- Subunit case + + elsif Is_Subunit then + Error_Msg_NE + (" - Error_Msg_NE - ("\ - Error_Msg_NE - ("\ - null; - end case; + elsif Is_Preelaborated (Unit_Entity) + and then not Is_Preelaborated (Depended_Entity) + and then not Is_Pure (Depended_Entity) + then + Error_Msg_NE + ("\