-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
with Nlists; use Nlists;
with Opt; use Opt;
with Sem; use Sem;
+with Sem_Aux; use Sem_Aux;
with Sem_Eval; use Sem_Eval;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
function In_RCI_Declaration (N : Node_Id) return Boolean;
-- Determines if a declaration is within the visible part of a Remote
- -- Call Interface compilation unit, for semantic checking purposes only,
+ -- Call Interface compilation unit, for semantic checking purposes only
-- (returns false within an instance and within the package body).
function In_RT_Declaration return Boolean;
- -- Determines if current scope is within a Remote Types compilation unit,
- -- for semantic checking purposes.
+ -- Determines if current scope is within the declaration of a Remote Types
+ -- unit, for semantic checking purposes.
function Is_Non_Remote_Access_Type (E : Entity_Id) return Boolean;
-- Returns true if the entity is a type whose full view is a non-remote
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;
elsif Is_Remote_Call_Interface (E) then
return Remote_Call_Interface;
- elsif Is_Preelaborated (E) then
- return Preelaborated;
-
else
return Normal;
end if;
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
- -- to be with'ed in package body.
+ -- to WITH anything in the package body, per (RM E.2(5)).
if (Unit_Category = Remote_Types
or else Unit_Category = Remote_Call_Interface)
then
null;
- -- Here we have an error
+ -- Special case: Remote_Types can depend on Preelaborated per
+ -- Ada 2005 AI 0206.
+
+ elsif Unit_Category = Remote_Types
+ and then Is_Preelaborated (Depended_Entity)
+ then
+ null;
+
+ -- All other cases, we do 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;
+ Err := True;
+ end if;
+ end if;
- -- Subunit case
+ -- Here if we have an error
- elsif Is_Subunit then
- Error_Msg_NE
- ("<subunit cannot depend on& " &
- "(parent has wrong categorization)", N, Depended_Entity);
+ if Err then
- -- Normal unit, not subunit
+ -- These messages are warnings in GNAT mode or if the -gnateP switch
+ -- was set. Otherwise these are real errors for real illegalities.
- else
- Error_Msg_NE
- ("<cannot depend on& " &
- "(wrong categorization)", N, Depended_Entity);
- end if;
+ -- The reason we suppress these errors in GNAT mode is that the run-
+ -- time has several instances of violations of the categorization
+ -- errors (e.g. Pure units withing Preelaborate units. All these
+ -- violations are harmless in the cases where we intend them, and
+ -- we suppress the warnings with Warnings (Off). In cases where we
+ -- do not intend the violation, warnings are errors in GNAT mode
+ -- anyway, so we will still get an error.
- -- Add further explanation for common cases
+ Error_Msg_Warn :=
+ Treat_Categorization_Errors_As_Warnings or GNAT_Mode;
- case Unit_Category is
- when Pure =>
- Error_Msg_NE
- ("\<pure unit cannot depend on non-pure unit",
- N, Depended_Entity);
+ -- 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).
- when Preelaborated =>
- Error_Msg_NE
- ("\<preelaborated unit cannot depend on " &
- "non-preelaborated unit",
- N, Depended_Entity);
+ 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;
- when others =>
- null;
- end case;
+ -- 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
+ 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;
-- currently visible.
return Present (Rep_Item)
- and then (Ada_Version < Ada_05
+ and then (Ada_Version < Ada_2005
or else At_Any_Place
or else not Is_Hidden (Entity (Rep_Item)));
end Has_Stream_Attribute_Definition;
-- of an RCI unit.
return Is_Remote_Call_Interface (Unit_Entity)
- and then (Ekind (Unit_Entity) = E_Package
- or else Ekind (Unit_Entity) = E_Generic_Package)
+ and then Is_Package_Or_Generic_Package (Unit_Entity)
and then Unit_Kind /= N_Package_Body
and then List_Containing (N) =
Visible_Declarations
-- There are no restrictions on the body of a Remote Types unit
return Is_Remote_Types (Unit_Entity)
- and then (Ekind (Unit_Entity) = E_Package
- or else Ekind (Unit_Entity) = E_Generic_Package)
+ and then Is_Package_Or_Generic_Package (Unit_Entity)
and then Unit_Kind /= N_Package_Body
and then not In_Package_Body (Unit_Entity)
and then not In_Instance;
-- This test is skipped in Ada 2005 (see AI-366)
- if Ada_Version < Ada_05
+ if Ada_Version < Ada_2005
and then Comes_From_Source (T)
and then In_Pure_Unit
and then not In_Subprogram_Task_Protected_Unit
-- Don't need this check in Ada 2005 mode, where this is all taken
-- care of by the mechanism for Preelaborable Initialization.
- if Ada_Version >= Ada_05 then
+ if Ada_Version >= Ada_2005 then
return;
end if;
-- Exclude generic specs from the checks (this will get rechecked
-- on instantiations).
- if Inside_A_Generic
- and then No (Enclosing_Generic_Body (Id))
- then
+ if Inside_A_Generic and then No (Enclosing_Generic_Body (Id)) then
return;
end if;
- -- Required checks for declaration that is in a preelaborated
- -- package and is not within some subprogram.
+ -- Required checks for declaration that is in a preelaborated package
+ -- and is not within some subprogram.
if In_Preelaborated_Unit
and then not In_Subprogram_Or_Concurrent_Unit
then
-- Check for default initialized variable case. Note that in
- -- accordance with (RM B.1(24)) imported objects are not
- -- subject to default initialization.
+ -- accordance with (RM B.1(24)) imported objects are not subject to
+ -- default initialization.
-- If the initialization does not come from source and is an
-- aggregate, it is a static initialization that replaces an
-- implicit call, and must be treated as such.
if Present (E)
- and then
- (Comes_From_Source (E) or else Nkind (E) /= N_Aggregate)
+ and then (Comes_From_Source (E) or else Nkind (E) /= N_Aggregate)
then
null;
-- marked with this pragma in the predefined library are
-- not treated specially.
- if Ada_Version < Ada_05 then
+ if Ada_Version < Ada_2005 then
Error_Msg_N
("private object not allowed in preelaborated unit",
N);
then
Error_Msg_Sloc := Sloc (Ent);
- if Ada_Version >= Ada_05 then
+ if Ada_Version >= Ada_2005 then
Error_Msg_NE
("\would be legal if pragma Preelaborable_" &
"Initialization given for & #", N, Ent);
elsif Nkind (Odf) = N_Subtype_Indication then
Ent := Etype (Subtype_Mark (Odf));
- elsif
- Nkind (Odf) = N_Constrained_Array_Definition
- then
+ elsif Nkind (Odf) = N_Constrained_Array_Definition then
Ent := Component_Type (T);
-
- -- else
- -- return;
end if;
if Is_Task_Type (Ent)
end;
end if;
- -- Non-static discriminant not allowed in preelaborated unit
- -- Controlled object of a type with a user-defined Initialize
- -- is forbidden as well.
+ -- Non-static discriminants not allowed in preelaborated unit.
+ -- Objects of a controlled type with a user-defined Initialize
+ -- are forbidden as well.
if Is_Record_Type (Etype (Id)) then
declare
if Nkind (PEE) = N_Full_Type_Declaration
and then not Static_Discriminant_Expr
- (Discriminant_Specifications (PEE))
+ (Discriminant_Specifications (PEE))
then
Error_Msg_N
("non-static discriminant in preelaborated unit",
-- except within a subprogram, generic subprogram, task unit, or
-- protected unit (RM 10.2.1(16)).
- if In_Pure_Unit
- and then not In_Subprogram_Task_Protected_Unit
- then
+ if In_Pure_Unit and then not In_Subprogram_Task_Protected_Unit then
Error_Msg_N ("declaration of variable not allowed in pure unit", N);
-- The visible part of an RCI library unit must not contain the
-- declaration of a variable (RM E.1.3(9))
elsif In_RCI_Declaration (N) then
- Error_Msg_N ("declaration of variable not allowed in rci unit", N);
+ Error_Msg_N ("visible variable not allowed in 'R'C'I unit", N);
-- The visible part of a Shared Passive library unit must not contain
-- the declaration of a variable (RM E.2.2(7))
- elsif In_RT_Declaration then
+ elsif In_RT_Declaration and then not In_Private_Part (Id) then
Error_Msg_N
- ("variable declaration not allowed in remote types unit", N);
+ ("visible variable not allowed in remote types unit", N);
end if;
end Validate_Object_Declaration;
begin
Desig_Type := Etype (Designated_Type (T));
+ -- No action needed for concurrent types
+
+ if Is_Concurrent_Type (Desig_Type) then
+ return;
+ end if;
+
Primitive_Subprograms := Primitive_Operations (Desig_Type);
Subprogram_Elmt := First_Elmt (Primitive_Subprograms);
null;
- elsif Ekind (Param_Type) = E_Anonymous_Access_Type
- or else Ekind (Param_Type) = E_Anonymous_Access_Subprogram_Type
+ elsif Ekind_In (Param_Type, E_Anonymous_Access_Type,
+ E_Anonymous_Access_Subprogram_Type)
then
-- From RM E.2.2(14), no anonymous access parameter other than
-- controlling ones may be used (because an anonymous access
("limited type not allowed in rci unit", Parent (E));
Explain_Limited_Type (E, Parent (E));
- elsif Ekind (E) = E_Generic_Function
- or else Ekind (E) = E_Generic_Package
- or else Ekind (E) = E_Generic_Procedure
+ elsif Ekind_In (E, E_Generic_Function,
+ E_Generic_Package,
+ E_Generic_Procedure)
then
Error_Msg_N ("generic declaration not allowed in rci unit",
Parent (E));
Type_Decl := Parent (Param_Type);
if Ekind (Param_Type) = E_Anonymous_Access_Type then
-
if K = N_Subprogram_Declaration then
Error_Node := Param_Spec;
end if;
Base_Under_Type := Base_Type (Underlying_Type
(Base_Param_Type));
- if (Ada_Version < Ada_05
+ if (Ada_Version < Ada_2005
and then
(No (TSS (Base_Param_Type, TSS_Stream_Read))
or else
or else
No (TSS (Base_Under_Type, TSS_Stream_Write))))
or else
- (Ada_Version >= Ada_05
+ (Ada_Version >= Ada_2005
and then
(No (TSS (Base_Param_Type, TSS_Stream_Read))
or else
Error_Node := Param_Spec;
end if;
- if Ada_Version >= Ada_05 then
+ if Ada_Version >= Ada_2005 then
Error_Msg_N
("limited parameter in 'R'C'I unit "
& "must have visible read/write attributes ",
-- Start of processing for Validate_Remote_Access_Object_Type_Declaration
begin
- -- We are called from Analyze_Type_Declaration, and the Nkind of the
- -- given node is N_Access_To_Object_Definition.
+ -- We are called from Analyze_Full_Type_Declaration, and the Nkind of
+ -- the given node is N_Access_To_Object_Definition.
if not Comes_From_Source (T)
or else (not In_RCI_Declaration (Parent (T))
-- Check RCI or RT unit type declaration. It may not contain the
-- declaration of an access-to-object type unless it is a general access
- -- type that designates a class-wide limited private type. There are
- -- also constraints on the primitive subprograms of the class-wide type
- -- (RM E.2.2(14), see Validate_RACW_Primitives).
+ -- type that designates a class-wide limited private type or subtype.
+ -- There are also constraints on the primitive subprograms of the
+ -- class-wide type (RM E.2.2(14), see Validate_RACW_Primitives).
if Ekind (T) /= E_General_Access_Type
- or else Ekind (Designated_Type (T)) /= E_Class_Wide_Type
+ or else not Is_Class_Wide_Type (Designated_Type (T))
then
if In_RCI_Declaration (Parent (T)) then
Error_Msg_N
"non-remote access type", U_Typ);
end if;
- if Ada_Version >= Ada_05 then
+ if Ada_Version >= Ada_2005 then
Error_Msg_N
("\must have visible Read and Write attribute " &
"definition clauses (RM E.2.2(8))", U_Typ);
-- Start of processing for Validate_SP_Access_Object_Type_Decl
begin
- -- We are called from Sem_Ch3.Analyze_Type_Declaration, and the
+ -- We are called from Sem_Ch3.Analyze_Full_Type_Declaration, and the
-- Nkind of the given entity is N_Access_To_Object_Definition.
if not Comes_From_Source (T)
Flag_Non_Static_Expr
("non-static object name in preelaborated unit", N);
- -- We take the view that a constant defined in another preelaborated
- -- unit is preelaborable, even though it may have a private type and
- -- thus appear non-static in a client. This must be the intent of
- -- the language, but currently is an RM gap ???
+ -- Give an error for a reference to a nonstatic constant, unless the
+ -- constant is in another GNAT library unit that is preelaborable.
elsif Ekind (Entity (N)) = E_Constant
and then not Is_Static_Expression (N)
OSDN Git Service
