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
This commit is contained in:
parent
4d84fe7cee
commit
ff69f95af0
|
@ -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>
|
2009-04-08 Robert Dewar <dewar@adacore.com>
|
||||||
|
|
||||||
* ug_words: Add /ASSUME_VALID for -gnatB
|
* ug_words: Add /ASSUME_VALID for -gnatB
|
||||||
|
|
|
@ -113,22 +113,18 @@ package body Sem_Cat is
|
||||||
Info_Node : Node_Id;
|
Info_Node : Node_Id;
|
||||||
Is_Subunit : Boolean)
|
Is_Subunit : Boolean)
|
||||||
is
|
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,
|
-- Here we define an enumeration type to represent categorization types,
|
||||||
-- ordered so that a unit with a given categorization can only WITH
|
-- ordered so that a unit with a given categorization can only WITH
|
||||||
-- units with lower or equal categorization type.
|
-- 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
|
type Categorization is
|
||||||
(Pure,
|
(Pure,
|
||||||
Shared_Passive,
|
Shared_Passive,
|
||||||
Remote_Types,
|
Remote_Types,
|
||||||
Remote_Call_Interface,
|
Remote_Call_Interface,
|
||||||
Preelaborated,
|
|
||||||
Normal);
|
Normal);
|
||||||
|
|
||||||
function Get_Categorization (E : Entity_Id) return Categorization;
|
function Get_Categorization (E : Entity_Id) return Categorization;
|
||||||
|
@ -165,9 +161,6 @@ package body Sem_Cat is
|
||||||
elsif Is_Remote_Call_Interface (E) then
|
elsif Is_Remote_Call_Interface (E) then
|
||||||
return Remote_Call_Interface;
|
return Remote_Call_Interface;
|
||||||
|
|
||||||
elsif Is_Preelaborated (E) then
|
|
||||||
return Preelaborated;
|
|
||||||
|
|
||||||
else
|
else
|
||||||
return Normal;
|
return Normal;
|
||||||
end if;
|
end if;
|
||||||
|
@ -186,73 +179,87 @@ package body Sem_Cat is
|
||||||
return;
|
return;
|
||||||
end if;
|
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);
|
Unit_Category := Get_Categorization (Unit_Entity);
|
||||||
With_Category := Get_Categorization (Depended_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
|
if With_Category > Unit_Category then
|
||||||
|
|
||||||
-- Special case: Remote_Types and Remote_Call_Interface are allowed
|
-- 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
|
if (Unit_Category = Remote_Types
|
||||||
or else Unit_Category = Remote_Call_Interface)
|
or else Unit_Category = Remote_Call_Interface)
|
||||||
and then In_Package_Body (Unit_Entity)
|
and then In_Package_Body (Unit_Entity)
|
||||||
then
|
then
|
||||||
null;
|
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
|
||||||
|
("<subunit cannot depend on& " &
|
||||||
|
"(parent has wrong categorization)", N, Depended_Entity);
|
||||||
|
|
||||||
|
-- Normal unit, not subunit
|
||||||
|
|
||||||
else
|
else
|
||||||
-- Don't give error if main unit is not an internal unit, and the
|
Error_Msg_NE
|
||||||
-- unit generating the message is an internal unit. This is the
|
("<cannot depend on& " &
|
||||||
-- situation in which such messages would be ignored in any case,
|
"(wrong categorization)", N, Depended_Entity);
|
||||||
-- so it is convenient not to generate them (since it causes
|
end if;
|
||||||
-- annoying interference with debugging).
|
|
||||||
|
|
||||||
if Is_Internal_File_Name (Unit_File_Name (Current_Sem_Unit))
|
-- Add further explanation for Pure/Preelaborate common cases
|
||||||
and then not Is_Internal_File_Name (Unit_File_Name (Main_Unit))
|
|
||||||
then
|
|
||||||
return;
|
|
||||||
|
|
||||||
-- Subunit case
|
if Unit_Category = Pure then
|
||||||
|
Error_Msg_NE
|
||||||
|
("\<pure unit cannot depend on non-pure unit",
|
||||||
|
N, Depended_Entity);
|
||||||
|
|
||||||
elsif Is_Subunit then
|
elsif Is_Preelaborated (Unit_Entity)
|
||||||
Error_Msg_NE
|
and then not Is_Preelaborated (Depended_Entity)
|
||||||
("<subunit cannot depend on& " &
|
and then not Is_Pure (Depended_Entity)
|
||||||
"(parent has wrong categorization)", N, Depended_Entity);
|
then
|
||||||
|
Error_Msg_NE
|
||||||
-- Normal unit, not subunit
|
("\<preelaborated unit cannot depend on "
|
||||||
|
& "non-preelaborated unit",
|
||||||
else
|
N, Depended_Entity);
|
||||||
Error_Msg_NE
|
|
||||||
("<cannot depend on& " &
|
|
||||||
"(wrong categorization)", N, Depended_Entity);
|
|
||||||
end if;
|
|
||||||
|
|
||||||
-- Add further explanation for common cases
|
|
||||||
|
|
||||||
case Unit_Category is
|
|
||||||
when Pure =>
|
|
||||||
Error_Msg_NE
|
|
||||||
("\<pure unit cannot depend on non-pure unit",
|
|
||||||
N, Depended_Entity);
|
|
||||||
|
|
||||||
when Preelaborated =>
|
|
||||||
Error_Msg_NE
|
|
||||||
("\<preelaborated unit cannot depend on " &
|
|
||||||
"non-preelaborated unit",
|
|
||||||
N, Depended_Entity);
|
|
||||||
|
|
||||||
when others =>
|
|
||||||
null;
|
|
||||||
end case;
|
|
||||||
end if;
|
end if;
|
||||||
end if;
|
end if;
|
||||||
end Check_Categorization_Dependencies;
|
end Check_Categorization_Dependencies;
|
||||||
|
|
|
@ -6802,6 +6802,11 @@ package body Sem_Util is
|
||||||
and then Present (Etype (Orig_Node))
|
and then Present (Etype (Orig_Node))
|
||||||
and then Is_Access_Type (Etype (Orig_Node))
|
and then Is_Access_Type (Etype (Orig_Node))
|
||||||
then
|
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
|
return
|
||||||
(Nkind (Orig_Node) = N_Function_Call
|
(Nkind (Orig_Node) = N_Function_Call
|
||||||
and then not Is_Access_Constant (Etype (Prefix (N))))
|
and then not Is_Access_Constant (Etype (Prefix (N))))
|
||||||
|
|
Loading…
Reference in New Issue