1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- Extensive contributions were provided by Ada Core Technologies Inc. --
26 ------------------------------------------------------------------------------
28 with Atree; use Atree;
29 with Debug; use Debug;
30 with Einfo; use Einfo;
31 with Elists; use Elists;
32 with Errout; use Errout;
33 with Exp_Tss; use Exp_Tss;
34 with Fname; use Fname;
36 with Nlists; use Nlists;
38 with Sem_Util; use Sem_Util;
39 with Sinfo; use Sinfo;
40 with Snames; use Snames;
41 with Stand; use Stand;
43 package body Sem_Cat is
45 -----------------------
46 -- Local Subprograms --
47 -----------------------
49 procedure Check_Categorization_Dependencies
50 (Unit_Entity : Entity_Id;
51 Depended_Entity : Entity_Id;
53 Is_Subunit : Boolean);
54 -- This procedure checks that the categorization of a lib unit and that
55 -- of the depended unit satisfy dependency restrictions.
56 -- The depended_entity can be the entity in a with_clause item, in which
57 -- case Info_Node denotes that item. The depended_entity can also be the
58 -- parent unit of a child unit, in which case Info_Node is the declaration
59 -- of the child unit. The error message is posted on Info_Node, and is
60 -- specialized if Is_Subunit is true.
62 procedure Check_Non_Static_Default_Expr
65 -- Iterate through the component list of a record definition, check
66 -- that no component is declared with a nonstatic default value.
67 -- If a nonstatic default exists, report an error on Obj_Decl.
69 -- Iterate through the component list of a record definition, check
70 -- that no component is declared with a non-static default value.
72 function Missing_Read_Write_Attributes (E : Entity_Id) return Boolean;
73 -- Return True if the entity or one of its subcomponent is an access
74 -- type which does not have user-defined Read and Write attribute.
76 function In_RCI_Declaration (N : Node_Id) return Boolean;
77 -- Determines if a declaration is within the visible part of a Remote
78 -- Call Interface compilation unit, for semantic checking purposes only,
79 -- (returns false within an instance and within the package body).
81 function In_RT_Declaration return Boolean;
82 -- Determines if current scope is within a Remote Types compilation unit,
83 -- for semantic checking purposes.
85 function Is_Non_Remote_Access_Type (E : Entity_Id) return Boolean;
86 -- Returns true if the entity is a non-remote access type
88 function In_Shared_Passive_Unit return Boolean;
89 -- Determines if current scope is within a Shared Passive compilation unit
91 function Static_Discriminant_Expr (L : List_Id) return Boolean;
92 -- Iterate through the list of discriminants to check if any of them
93 -- contains non-static default expression, which is a violation in
94 -- a preelaborated library unit.
96 procedure Validate_Remote_Access_Object_Type_Declaration (T : Entity_Id);
97 -- Check validity of declaration if RCI unit. It should not contain
98 -- the declaration of an access-to-object type unless it is a
99 -- general access type that designates a class-wide limited
100 -- private type. There are also constraints about the primitive
101 -- subprograms of the class-wide type. RM E.2 (9, 13, 14)
103 function Is_Recursively_Limited_Private (E : Entity_Id) return Boolean;
104 -- Return True if E is a limited private type, or if E is a private
105 -- extension of a type whose parent verifies this property (hence the
106 -- recursive keyword).
108 ---------------------------------------
109 -- Check_Categorization_Dependencies --
110 ---------------------------------------
112 procedure Check_Categorization_Dependencies
113 (Unit_Entity : Entity_Id;
114 Depended_Entity : Entity_Id;
116 Is_Subunit : Boolean)
118 N : Node_Id := Info_Node;
120 type Categorization is
121 (Pure, Shared_Passive, Remote_Types,
122 Remote_Call_Interface, Pre_Elaborated, Normal);
124 Unit_Category : Categorization;
125 With_Category : Categorization;
127 function Get_Categorization (E : Entity_Id) return Categorization;
128 -- Check categorization flags from entity, and return in the form
129 -- of a corresponding enumeration value.
131 function Get_Categorization (E : Entity_Id) return Categorization is
133 if Is_Preelaborated (E) then
134 return Pre_Elaborated;
135 elsif Is_Pure (E) then
137 elsif Is_Shared_Passive (E) then
138 return Shared_Passive;
139 elsif Is_Remote_Types (E) then
141 elsif Is_Remote_Call_Interface (E) then
142 return Remote_Call_Interface;
146 end Get_Categorization;
148 -- Start of processing for Check_Categorization_Dependencies
151 -- Intrinsic subprograms are preelaborated, so do not impose any
152 -- categorization dependencies.
154 if Is_Intrinsic_Subprogram (Depended_Entity) then
158 Unit_Category := Get_Categorization (Unit_Entity);
159 With_Category := Get_Categorization (Depended_Entity);
161 if With_Category > Unit_Category then
163 if (Unit_Category = Remote_Types
164 or else Unit_Category = Remote_Call_Interface)
165 and then In_Package_Body (Unit_Entity)
169 elsif Is_Subunit then
170 Error_Msg_NE ("subunit cannot depend on&"
171 & " (parent has wrong categorization)", N, Depended_Entity);
173 Error_Msg_NE ("current unit cannot depend on&"
174 & " (wrong categorization)", N, Depended_Entity);
178 end Check_Categorization_Dependencies;
180 -----------------------------------
181 -- Check_Non_Static_Default_Expr --
182 -----------------------------------
184 procedure Check_Non_Static_Default_Expr
189 Component_Decl : Node_Id;
192 if Nkind (Type_Def) = N_Derived_Type_Definition then
193 Recdef := Record_Extension_Part (Type_Def);
203 -- Check that component declarations do not involve:
205 -- a. a non-static default expression, where the object is
206 -- declared to be default initialized.
208 -- b. a dynamic Itype (discriminants and constraints)
210 if Null_Present (Recdef) then
213 Component_Decl := First (Component_Items (Component_List (Recdef)));
216 while Present (Component_Decl)
217 and then Nkind (Component_Decl) = N_Component_Declaration
219 if Present (Expression (Component_Decl))
220 and then Nkind (Expression (Component_Decl)) /= N_Null
221 and then not Is_Static_Expression (Expression (Component_Decl))
223 Error_Msg_Sloc := Sloc (Component_Decl);
225 ("object in preelaborated unit has nonstatic default#",
228 -- Fix this later ???
230 -- elsif Has_Dynamic_Itype (Component_Decl) then
232 -- ("dynamic type discriminant," &
233 -- " constraint in preelaborated unit",
237 Next (Component_Decl);
239 end Check_Non_Static_Default_Expr;
241 ---------------------------
242 -- In_Preelaborated_Unit --
243 ---------------------------
245 function In_Preelaborated_Unit return Boolean is
246 Unit_Entity : constant Entity_Id := Current_Scope;
247 Unit_Kind : constant Node_Kind :=
248 Nkind (Unit (Cunit (Current_Sem_Unit)));
251 -- There are no constraints on body of remote_call_interface or
252 -- remote_types packages..
254 return (Unit_Entity /= Standard_Standard)
255 and then (Is_Preelaborated (Unit_Entity)
256 or else Is_Pure (Unit_Entity)
257 or else Is_Shared_Passive (Unit_Entity)
259 ((Is_Remote_Types (Unit_Entity)
260 or else Is_Remote_Call_Interface (Unit_Entity))
261 and then Ekind (Unit_Entity) = E_Package
262 and then Unit_Kind /= N_Package_Body
263 and then not In_Package_Body (Unit_Entity)
264 and then not In_Instance));
265 end In_Preelaborated_Unit;
271 function In_Pure_Unit return Boolean is
273 return Is_Pure (Current_Scope);
276 ------------------------
277 -- In_RCI_Declaration --
278 ------------------------
280 function In_RCI_Declaration (N : Node_Id) return Boolean is
281 Unit_Entity : constant Entity_Id := Current_Scope;
282 Unit_Kind : constant Node_Kind :=
283 Nkind (Unit (Cunit (Current_Sem_Unit)));
286 -- There are no restrictions on the private part or body
289 return Is_Remote_Call_Interface (Unit_Entity)
290 and then (Ekind (Unit_Entity) = E_Package
291 or else Ekind (Unit_Entity) = E_Generic_Package)
292 and then Unit_Kind /= N_Package_Body
293 and then List_Containing (N) =
295 (Specification (Unit_Declaration_Node (Unit_Entity)))
296 and then not In_Package_Body (Unit_Entity)
297 and then not In_Instance;
298 end In_RCI_Declaration;
300 -----------------------
301 -- In_RT_Declaration --
302 -----------------------
304 function In_RT_Declaration return Boolean is
305 Unit_Entity : constant Entity_Id := Current_Scope;
306 Unit_Kind : constant Node_Kind :=
307 Nkind (Unit (Cunit (Current_Sem_Unit)));
310 -- There are no restrictions on the body of a Remote Types unit.
312 return Is_Remote_Types (Unit_Entity)
313 and then (Ekind (Unit_Entity) = E_Package
314 or else Ekind (Unit_Entity) = E_Generic_Package)
315 and then Unit_Kind /= N_Package_Body
316 and then not In_Package_Body (Unit_Entity)
317 and then not In_Instance;
318 end In_RT_Declaration;
320 ----------------------------
321 -- In_Shared_Passive_Unit --
322 ----------------------------
324 function In_Shared_Passive_Unit return Boolean is
325 Unit_Entity : constant Entity_Id := Current_Scope;
328 return Is_Shared_Passive (Unit_Entity);
329 end In_Shared_Passive_Unit;
331 ---------------------------------------
332 -- In_Subprogram_Task_Protected_Unit --
333 ---------------------------------------
335 function In_Subprogram_Task_Protected_Unit return Boolean is
340 -- The following is to verify that a declaration is inside
341 -- subprogram, generic subprogram, task unit, protected unit.
342 -- Used to validate if a lib. unit is Pure. RM 10.2.1(16).
344 -- Use scope chain to check successively outer scopes
351 or else K = E_Function
352 or else K = E_Generic_Procedure
353 or else K = E_Generic_Function
354 or else K = E_Task_Type
355 or else K = E_Task_Subtype
356 or else K = E_Protected_Type
357 or else K = E_Protected_Subtype
361 elsif E = Standard_Standard then
368 end In_Subprogram_Task_Protected_Unit;
370 -------------------------------
371 -- Is_Non_Remote_Access_Type --
372 -------------------------------
374 function Is_Non_Remote_Access_Type (E : Entity_Id) return Boolean is
376 return Is_Access_Type (E)
377 and then not Is_Remote_Access_To_Class_Wide_Type (E)
378 and then not Is_Remote_Access_To_Subprogram_Type (E);
379 end Is_Non_Remote_Access_Type;
381 ------------------------------------
382 -- Is_Recursively_Limited_Private --
383 ------------------------------------
385 function Is_Recursively_Limited_Private (E : Entity_Id) return Boolean is
386 P : constant Node_Id := Parent (E);
389 if Nkind (P) = N_Private_Type_Declaration
390 and then Is_Limited_Record (E)
393 elsif Nkind (P) = N_Private_Extension_Declaration then
394 return Is_Recursively_Limited_Private (Etype (E));
395 elsif Nkind (P) = N_Formal_Type_Declaration
396 and then Ekind (E) = E_Record_Type_With_Private
397 and then Is_Generic_Type (E)
398 and then Is_Limited_Record (E)
404 end Is_Recursively_Limited_Private;
406 ----------------------------------
407 -- Missing_Read_Write_Attribute --
408 ----------------------------------
410 function Missing_Read_Write_Attributes (E : Entity_Id) return Boolean is
411 Component : Entity_Id;
412 Component_Type : Entity_Id;
414 function Has_Read_Write_Attributes (E : Entity_Id) return Boolean;
415 -- Return True if entity has Read and Write attributes
417 -------------------------------
418 -- Has_Read_Write_Attributes --
419 -------------------------------
421 function Has_Read_Write_Attributes (E : Entity_Id) return Boolean is
422 Rep_Item : Node_Id := First_Rep_Item (E);
423 Read_Attribute : Boolean := False;
424 Write_Attribute : Boolean := False;
427 -- We start from the declaration node and then loop until the end
428 -- of the list until we find those two attribute definition clauses.
430 while Present (Rep_Item) loop
431 if Chars (Rep_Item) = Name_Read then
432 Read_Attribute := True;
433 elsif Chars (Rep_Item) = Name_Write then
434 Write_Attribute := True;
437 if Read_Attribute and Write_Attribute then
441 Next_Rep_Item (Rep_Item);
445 end Has_Read_Write_Attributes;
447 -- Start of processing for Missing_Read_Write_Attributes
450 if Has_Read_Write_Attributes (E) then
452 elsif Is_Non_Remote_Access_Type (E) then
456 if Is_Record_Type (E) then
457 Component := First_Entity (E);
458 while Present (Component) loop
459 Component_Type := Etype (Component);
461 if (Is_Non_Remote_Access_Type (Component_Type)
462 or else Is_Record_Type (Component_Type))
463 and then Missing_Read_Write_Attributes (Component_Type)
468 Next_Entity (Component);
473 end Missing_Read_Write_Attributes;
475 -------------------------------------
476 -- Set_Categorization_From_Pragmas --
477 -------------------------------------
479 procedure Set_Categorization_From_Pragmas (N : Node_Id) is
480 P : constant Node_Id := Parent (N);
481 S : constant Entity_Id := Current_Scope;
483 procedure Set_Parents (Visibility : Boolean);
484 -- If this is a child instance, the parents are not immediately
485 -- visible during analysis. Make them momentarily visible so that
486 -- the argument of the pragma can be resolved properly, and reset
489 procedure Set_Parents (Visibility : Boolean) is
490 Par : Entity_Id := Scope (S);
493 while Present (Par) and then Par /= Standard_Standard loop
494 Set_Is_Immediately_Visible (Par, Visibility);
500 -- Deal with categorization pragmas in Pragmas of Compilation_Unit.
501 -- The purpose is to set categorization flags before analyzing the
502 -- unit itself, so as to diagnose violations of categorization as
503 -- we process each declaration, even though the pragma appears after
506 if Nkind (P) /= N_Compilation_Unit then
511 PN : Node_Id := First (Pragmas_After (Aux_Decls_Node (P)));
516 and then Is_Generic_Instance (S)
521 while Present (PN) loop
523 -- Skip implicit types that may have been introduced by
524 -- previous analysis.
526 if Nkind (PN) = N_Pragma then
528 case Get_Pragma_Id (Chars (PN)) is
529 when Pragma_All_Calls_Remote |
530 Pragma_Preelaborate |
532 Pragma_Remote_Call_Interface |
533 Pragma_Remote_Types |
534 Pragma_Shared_Passive => Analyze (PN);
542 and then Is_Generic_Instance (S)
548 end Set_Categorization_From_Pragmas;
550 ------------------------------
551 -- Static_Discriminant_Expr --
552 ------------------------------
554 function Static_Discriminant_Expr (L : List_Id) return Boolean is
555 Discriminant_Spec : Node_Id;
558 Discriminant_Spec := First (L);
559 while Present (Discriminant_Spec) loop
560 if Present (Expression (Discriminant_Spec))
561 and then not Is_Static_Expression (Expression (Discriminant_Spec))
566 Next (Discriminant_Spec);
570 end Static_Discriminant_Expr;
572 --------------------------------------
573 -- Validate_Access_Type_Declaration --
574 --------------------------------------
576 procedure Validate_Access_Type_Declaration (T : Entity_Id; N : Node_Id) is
577 Def : constant Node_Id := Type_Definition (N);
581 when N_Access_To_Subprogram_Definition =>
583 -- A pure library_item must not contain the declaration of a
584 -- named access type, except within a subprogram, generic
585 -- subprogram, task unit, or protected unit (RM 10.2.1(16)).
587 if Comes_From_Source (T)
588 and then In_Pure_Unit
589 and then not In_Subprogram_Task_Protected_Unit
591 Error_Msg_N ("named access type not allowed in pure unit", T);
594 when N_Access_To_Object_Definition =>
596 if Comes_From_Source (T)
597 and then In_Pure_Unit
598 and then not In_Subprogram_Task_Protected_Unit
601 ("named access type not allowed in pure unit", T);
604 -- Check for RCI unit type declaration. It should not contain
605 -- the declaration of an access-to-object type unless it is a
606 -- general access type that designates a class-wide limited
607 -- private type. There are also constraints about the primitive
608 -- subprograms of the class-wide type.
610 Validate_Remote_Access_Object_Type_Declaration (T);
612 -- Check for shared passive unit type declaration. It should
613 -- not contain the declaration of access to class wide type,
614 -- access to task type and access to protected type with entry.
616 Validate_SP_Access_Object_Type_Decl (T);
621 -- Set Categorization flag of package on entity as well, to allow
622 -- easy checks later on for required validations of RCI units. This
623 -- is only done for entities that are in the original source.
625 if Comes_From_Source (T) then
626 if Is_Remote_Call_Interface (Scope (T))
627 and then not In_Package_Body (Scope (T))
629 Set_Is_Remote_Call_Interface (T);
632 if Is_Remote_Types (Scope (T))
633 and then not In_Package_Body (Scope (T))
635 Set_Is_Remote_Types (T);
638 end Validate_Access_Type_Declaration;
640 ----------------------------
641 -- Validate_Ancestor_Part --
642 ----------------------------
644 procedure Validate_Ancestor_Part (N : Node_Id) is
645 A : constant Node_Id := Ancestor_Part (N);
646 T : Entity_Id := Entity (A);
649 if In_Preelaborated_Unit
650 and then not In_Subprogram_Or_Concurrent_Unit
651 and then (not Inside_A_Generic
652 or else Present (Enclosing_Generic_Body (N)))
654 -- We relax the restriction of 10.2.1(9) within GNAT
655 -- units to allow packages such as Ada.Strings.Unbounded
656 -- to be implemented (i.p., Null_Unbounded_String).
657 -- (There are ACVC tests that check that the restriction
658 -- is enforced, but note that AI-161, once approved,
659 -- will relax the restriction prohibiting default-
660 -- initialized objects of private and controlled
663 if Is_Private_Type (T)
664 and then not Is_Internal_File_Name
665 (Unit_File_Name (Get_Source_Unit (N)))
668 ("private ancestor type not allowed in preelaborated unit", A);
670 elsif Is_Record_Type (T) then
671 if Nkind (Parent (T)) = N_Full_Type_Declaration then
672 Check_Non_Static_Default_Expr
673 (Type_Definition (Parent (T)), A);
677 end Validate_Ancestor_Part;
679 ----------------------------------------
680 -- Validate_Categorization_Dependency --
681 ----------------------------------------
683 procedure Validate_Categorization_Dependency
687 K : constant Node_Kind := Nkind (N);
688 P : Node_Id := Parent (N);
690 Is_Subunit : constant Boolean := Nkind (P) = N_Subunit;
693 -- Only validate library units and subunits. For subunits, checks
694 -- concerning withed units apply to the parent compilation unit.
701 and then not Is_Compilation_Unit (U)
702 and then not Is_Child_Unit (U)
709 if Nkind (P) /= N_Compilation_Unit then
713 -- Body of RCI unit does not need validation.
715 if Is_Remote_Call_Interface (E)
716 and then (Nkind (N) = N_Package_Body
717 or else Nkind (N) = N_Subprogram_Body)
722 -- Process with clauses
726 Entity_Of_Withed : Entity_Id;
729 Item := First (Context_Items (P));
731 while Present (Item) loop
732 if Nkind (Item) = N_With_Clause
733 and then not Implicit_With (Item)
735 Entity_Of_Withed := Entity (Name (Item));
736 Check_Categorization_Dependencies
737 (U, Entity_Of_Withed, Item, Is_Subunit);
744 -- Child depends on parent; therefore parent should also
745 -- be categorized and satify the dependency hierarchy.
747 -- Check if N is a child spec.
749 if (K in N_Generic_Declaration or else
750 K in N_Generic_Instantiation or else
751 K in N_Generic_Renaming_Declaration or else
752 K = N_Package_Declaration or else
753 K = N_Package_Renaming_Declaration or else
754 K = N_Subprogram_Declaration or else
755 K = N_Subprogram_Renaming_Declaration)
756 and then Present (Parent_Spec (N))
759 Parent_Lib_U : constant Node_Id := Parent_Spec (N);
760 Parent_Kind : constant Node_Kind :=
761 Nkind (Unit (Parent_Lib_U));
762 Parent_Entity : Entity_Id;
765 if Parent_Kind = N_Package_Instantiation
766 or else Parent_Kind = N_Procedure_Instantiation
767 or else Parent_Kind = N_Function_Instantiation
768 or else Parent_Kind = N_Package_Renaming_Declaration
769 or else Parent_Kind in N_Generic_Renaming_Declaration
771 Parent_Entity := Defining_Entity (Unit (Parent_Lib_U));
775 Defining_Entity (Specification (Unit (Parent_Lib_U)));
778 Check_Categorization_Dependencies (E, Parent_Entity, N, False);
780 -- Verify that public child of an RCI library unit
781 -- must also be an RCI library unit (RM E.2.3(15)).
783 if Is_Remote_Call_Interface (Parent_Entity)
784 and then not Private_Present (P)
785 and then not Is_Remote_Call_Interface (E)
788 ("public child of rci unit must also be rci unit", N);
794 end Validate_Categorization_Dependency;
796 --------------------------------
797 -- Validate_Controlled_Object --
798 --------------------------------
800 procedure Validate_Controlled_Object (E : Entity_Id) is
802 -- For now, never apply this check for internal GNAT units, since we
803 -- have a number of cases in the library where we are stuck with objects
804 -- of this type, and the RM requires Preelaborate.
806 -- For similar reasons, we only do this check for source entities, since
807 -- we generate entities of this type in some situations.
809 -- Note that the 10.2.1(9) restrictions are not relevant to us anyway.
810 -- We have to enforce them for RM compatibility, but we have no trouble
811 -- accepting these objects and doing the right thing. Note that there is
812 -- no requirement that Preelaborate not actually generate any code!
814 if In_Preelaborated_Unit
815 and then not Debug_Flag_PP
816 and then Comes_From_Source (E)
818 Is_Internal_File_Name (Unit_File_Name (Get_Source_Unit (E)))
819 and then (not Inside_A_Generic
820 or else Present (Enclosing_Generic_Body (E)))
821 and then not Is_Protected_Type (Etype (E))
824 ("library level controlled object not allowed in " &
825 "preelaborated unit", E);
827 end Validate_Controlled_Object;
829 --------------------------------------
830 -- Validate_Null_Statement_Sequence --
831 --------------------------------------
833 procedure Validate_Null_Statement_Sequence (N : Node_Id) is
837 if In_Preelaborated_Unit then
838 Item := First (Statements (Handled_Statement_Sequence (N)));
840 while Present (Item) loop
841 if Nkind (Item) /= N_Label
842 and then Nkind (Item) /= N_Null_Statement
845 ("statements not allowed in preelaborated unit", Item);
852 end Validate_Null_Statement_Sequence;
854 ---------------------------------
855 -- Validate_Object_Declaration --
856 ---------------------------------
858 procedure Validate_Object_Declaration (N : Node_Id) is
859 Id : constant Entity_Id := Defining_Identifier (N);
860 E : constant Node_Id := Expression (N);
861 Odf : constant Node_Id := Object_Definition (N);
862 T : constant Entity_Id := Etype (Id);
865 -- Verify that any access to subprogram object does not have in its
866 -- subprogram profile access type parameters or limited parameters
867 -- without Read and Write attributes (E.2.3(13)).
869 Validate_RCI_Subprogram_Declaration (N);
871 -- Check that if we are in preelaborated elaboration code, then we
872 -- do not have an instance of a default initialized private, task or
873 -- protected object declaration which would violate (RM 10.2.1(9)).
874 -- Note that constants are never default initialized (and the test
875 -- below also filters out deferred constants). A variable is default
876 -- initialized if it does *not* have an initialization expression.
878 -- Filter out cases that are not declaration of a variable from source
880 if Nkind (N) /= N_Object_Declaration
881 or else Constant_Present (N)
882 or else not Comes_From_Source (Id)
887 -- Exclude generic specs from the checks (this will get rechecked
888 -- on instantiations).
891 and then not Present (Enclosing_Generic_Body (Id))
896 -- Required checks for declaration that is in a preelaborated
897 -- package and is not within some subprogram.
899 if In_Preelaborated_Unit
900 and then not In_Subprogram_Or_Concurrent_Unit
902 -- Check for default initialized variable case. Note that in
903 -- accordance with (RM B.1(24)) imported objects are not
904 -- subject to default initialization.
906 if No (E) and then not Is_Imported (Id) then
908 Ent : Entity_Id := T;
911 -- An array whose component type is a record with nonstatic
912 -- default expressions is a violation, so we get the array's
915 if Is_Array_Type (Ent) then
917 Comp_Type : Entity_Id := Component_Type (Ent);
920 while Is_Array_Type (Comp_Type) loop
921 Comp_Type := Component_Type (Comp_Type);
928 -- Object decl. that is of record type and has no default expr.
929 -- should check if there is any non-static default expression
930 -- in component decl. of the record type decl.
932 if Is_Record_Type (Ent) then
933 if Nkind (Parent (Ent)) = N_Full_Type_Declaration then
934 Check_Non_Static_Default_Expr
935 (Type_Definition (Parent (Ent)), N);
937 elsif Nkind (Odf) = N_Subtype_Indication
938 and then not Is_Array_Type (T)
939 and then not Is_Private_Type (T)
941 Check_Non_Static_Default_Expr (Type_Definition
942 (Parent (Entity (Subtype_Mark (Odf)))), N);
946 -- We relax the restriction of 10.2.1(9) within GNAT
947 -- units. (There are ACVC tests that check that the
948 -- restriction is enforced, but note that AI-161,
949 -- once approved, will relax the restriction prohibiting
950 -- default-initialized objects of private types, and
951 -- will recommend a pragma for marking private types.)
953 if (Is_Private_Type (Ent)
954 or else Depends_On_Private (Ent))
955 and then not Is_Internal_File_Name
956 (Unit_File_Name (Get_Source_Unit (N)))
959 ("private object not allowed in preelaborated unit", N);
962 -- Access to Task or Protected type
964 elsif Is_Entity_Name (Odf)
965 and then Present (Etype (Odf))
966 and then Is_Access_Type (Etype (Odf))
968 Ent := Designated_Type (Etype (Odf));
970 elsif Is_Entity_Name (Odf) then
973 elsif Nkind (Odf) = N_Subtype_Indication then
974 Ent := Etype (Subtype_Mark (Odf));
977 Nkind (Odf) = N_Constrained_Array_Definition
979 Ent := Component_Type (T);
985 if Is_Task_Type (Ent)
986 or else (Is_Protected_Type (Ent) and then Has_Entries (Ent))
989 ("concurrent object not allowed in preelaborated unit",
996 -- Non-static discriminant not allowed in preelaborayted unit
998 if Is_Record_Type (Etype (Id)) then
1000 ET : constant Entity_Id := Etype (Id);
1001 EE : constant Entity_Id := Etype (Etype (Id));
1005 if Has_Discriminants (ET)
1006 and then Present (EE)
1010 if Nkind (PEE) = N_Full_Type_Declaration
1011 and then not Static_Discriminant_Expr
1012 (Discriminant_Specifications (PEE))
1015 ("non-static discriminant in preelaborated unit",
1023 -- A pure library_item must not contain the declaration of any
1024 -- variable except within a subprogram, generic subprogram, task
1025 -- unit or protected unit (RM 10.2.1(16)).
1028 and then not In_Subprogram_Task_Protected_Unit
1030 Error_Msg_N ("declaration of variable not allowed in pure unit", N);
1032 -- The visible part of an RCI library unit must not contain the
1033 -- declaration of a variable (RM E.1.3(9))
1035 elsif In_RCI_Declaration (N) then
1036 Error_Msg_N ("declaration of variable not allowed in rci unit", N);
1038 -- The visible part of a Shared Passive library unit must not contain
1039 -- the declaration of a variable (RM E.2.2(7))
1041 elsif In_RT_Declaration then
1043 ("variable declaration not allowed in remote types unit", N);
1046 end Validate_Object_Declaration;
1048 --------------------------------
1049 -- Validate_RCI_Declarations --
1050 --------------------------------
1052 procedure Validate_RCI_Declarations (P : Entity_Id) is
1056 E := First_Entity (P);
1058 while Present (E) loop
1059 if Comes_From_Source (E) then
1061 if Is_Limited_Type (E) then
1063 ("Limited type not allowed in rci unit", Parent (E));
1065 elsif Ekind (E) = E_Generic_Function
1066 or else Ekind (E) = E_Generic_Package
1067 or else Ekind (E) = E_Generic_Procedure
1069 Error_Msg_N ("generic declaration not allowed in rci unit",
1072 elsif (Ekind (E) = E_Function
1073 or else Ekind (E) = E_Procedure)
1074 and then Has_Pragma_Inline (E)
1077 ("inlined subprogram not allowed in rci unit", Parent (E));
1079 -- Inner packages that are renamings need not be checked.
1080 -- Generic RCI packages are subject to the checks, but
1081 -- entities that come from formal packages are not part of the
1082 -- visible declarations of the package and are not checked.
1084 elsif Ekind (E) = E_Package then
1085 if Present (Renamed_Entity (E)) then
1088 elsif Ekind (P) /= E_Generic_Package
1089 or else List_Containing (Unit_Declaration_Node (E)) /=
1090 Generic_Formal_Declarations
1091 (Unit_Declaration_Node (P))
1093 Validate_RCI_Declarations (E);
1100 end Validate_RCI_Declarations;
1102 -----------------------------------------
1103 -- Validate_RCI_Subprogram_Declaration --
1104 -----------------------------------------
1106 procedure Validate_RCI_Subprogram_Declaration (N : Node_Id) is
1107 K : Node_Kind := Nkind (N);
1110 Param_Spec : Node_Id;
1111 Param_Type : Entity_Id;
1112 Base_Param_Type : Entity_Id;
1113 Type_Decl : Node_Id;
1114 Error_Node : Node_Id := N;
1117 -- There are two possible cases in which this procedure is called:
1119 -- 1. called from Analyze_Subprogram_Declaration.
1120 -- 2. called from Validate_Object_Declaration (access to subprogram).
1122 if not In_RCI_Declaration (N) then
1126 if K = N_Subprogram_Declaration then
1127 Profile := Parameter_Specifications (Specification (N));
1129 else pragma Assert (K = N_Object_Declaration);
1130 Id := Defining_Identifier (N);
1132 if Nkind (Id) = N_Defining_Identifier
1133 and then Nkind (Parent (Etype (Id))) = N_Full_Type_Declaration
1134 and then Ekind (Etype (Id)) = E_Access_Subprogram_Type
1137 Parameter_Specifications (Type_Definition (Parent (Etype (Id))));
1143 -- Iterate through the parameter specification list, checking that
1144 -- no access parameter and no limited type parameter in the list.
1147 if Present (Profile) then
1148 Param_Spec := First (Profile);
1150 while Present (Param_Spec) loop
1151 Param_Type := Etype (Defining_Identifier (Param_Spec));
1152 Type_Decl := Parent (Param_Type);
1154 if Ekind (Param_Type) = E_Anonymous_Access_Type then
1156 if K = N_Subprogram_Declaration then
1157 Error_Node := Param_Spec;
1160 -- Report error only if declaration is in source program.
1162 if Comes_From_Source
1163 (Defining_Entity (Specification (N)))
1166 ("subprogram in rci unit cannot have access parameter",
1170 -- For limited private type parameter, we check only the
1171 -- private declaration and ignore full type declaration,
1172 -- unless this is the only declaration for the type, eg.
1173 -- as a limited record.
1175 elsif Is_Limited_Type (Param_Type)
1176 and then (Nkind (Type_Decl) = N_Private_Type_Declaration
1178 (Nkind (Type_Decl) = N_Full_Type_Declaration
1179 and then not (Has_Private_Declaration (Param_Type))
1180 and then Comes_From_Source (N)))
1183 -- A limited parameter is legal only if user-specified
1184 -- Read and Write attributes exist for it.
1185 -- second part of RM E.2.3 (14)
1187 if No (Full_View (Param_Type))
1188 and then Ekind (Param_Type) /= E_Record_Type
1190 -- type does not have completion yet, so if declared in
1191 -- in the current RCI scope it is illegal, and will be
1192 -- flagged subsequently.
1196 Base_Param_Type := Base_Type (Underlying_Type (Param_Type));
1198 if No (TSS (Base_Param_Type, Name_uRead))
1199 or else No (TSS (Base_Param_Type, Name_uWrite))
1202 if K = N_Subprogram_Declaration then
1203 Error_Node := Param_Spec;
1207 ("limited parameter in rci unit "
1208 & "must have read/write attributes ", Error_Node);
1215 end Validate_RCI_Subprogram_Declaration;
1217 ----------------------------------------------------
1218 -- Validate_Remote_Access_Object_Type_Declaration --
1219 ----------------------------------------------------
1221 procedure Validate_Remote_Access_Object_Type_Declaration (T : Entity_Id) is
1222 Direct_Designated_Type : Entity_Id;
1223 Desig_Type : Entity_Id;
1224 Primitive_Subprograms : Elist_Id;
1225 Subprogram : Elmt_Id;
1226 Subprogram_Node : Node_Id;
1228 Param_Spec : Node_Id;
1229 Param_Type : Entity_Id;
1230 Limited_Type_Decl : Node_Id;
1233 -- We are called from Analyze_Type_Declaration, and the Nkind
1234 -- of the given node is N_Access_To_Object_Definition.
1236 if not Comes_From_Source (T)
1237 or else (not In_RCI_Declaration (Parent (T))
1238 and then not In_RT_Declaration)
1243 -- An access definition in the private part of a Remote Types package
1244 -- may be legal if it has user-defined Read and Write attributes. This
1245 -- will be checked at the end of the package spec processing.
1247 if In_RT_Declaration and then In_Private_Part (Scope (T)) then
1251 -- Check RCI unit type declaration. It should not contain the
1252 -- declaration of an access-to-object type unless it is a
1253 -- general access type that designates a class-wide limited
1254 -- private type. There are also constraints about the primitive
1255 -- subprograms of the class-wide type (RM E.2.3(14)).
1257 if Ekind (T) /= E_General_Access_Type
1258 or else Ekind (Designated_Type (T)) /= E_Class_Wide_Type
1260 if In_RCI_Declaration (Parent (T)) then
1262 ("access type in Remote_Call_Interface unit must be " &
1263 "general access", T);
1265 Error_Msg_N ("access type in Remote_Types unit must be " &
1266 "general access", T);
1268 Error_Msg_N ("\to class-wide type", T);
1272 Direct_Designated_Type := Designated_Type (T);
1274 Desig_Type := Etype (Direct_Designated_Type);
1276 if not Is_Recursively_Limited_Private (Desig_Type) then
1278 ("error in designated type of remote access to class-wide type", T);
1280 ("\must be tagged limited private or private extension of type", T);
1284 Primitive_Subprograms := Primitive_Operations (Desig_Type);
1285 Subprogram := First_Elmt (Primitive_Subprograms);
1287 while Subprogram /= No_Elmt loop
1288 Subprogram_Node := Node (Subprogram);
1290 if not Comes_From_Source (Subprogram_Node) then
1291 goto Next_Subprogram;
1294 Profile := Parameter_Specifications (Parent (Subprogram_Node));
1296 -- Profile must exist, otherwise not primitive operation
1298 Param_Spec := First (Profile);
1300 while Present (Param_Spec) loop
1302 -- Now find out if this parameter is a controlling parameter
1304 Param_Type := Parameter_Type (Param_Spec);
1306 if (Nkind (Param_Type) = N_Access_Definition
1307 and then Etype (Subtype_Mark (Param_Type)) = Desig_Type)
1308 or else (Nkind (Param_Type) /= N_Access_Definition
1309 and then Etype (Param_Type) = Desig_Type)
1311 -- It is a controlling parameter, so specific checks below
1317 Nkind (Param_Type) = N_Access_Definition
1319 -- From RM E.2.2(14), no access parameter other than
1320 -- controlling ones may be used.
1323 ("non-controlling access parameter", Param_Spec);
1326 Is_Limited_Type (Etype (Defining_Identifier (Param_Spec)))
1328 -- Not a controlling parameter, so type must have Read
1329 -- and Write attributes.
1330 -- ??? I suspect this to be dead code because any violation
1331 -- should be caught before in sem_attr.adb (with the message
1332 -- "limited type ... used in ... has no stream attr."). ST
1334 if Nkind (Param_Type) in N_Has_Etype
1335 and then Nkind (Parent (Etype (Param_Type))) =
1336 N_Private_Type_Declaration
1338 Param_Type := Etype (Param_Type);
1339 Limited_Type_Decl := Parent (Param_Type);
1341 if No (TSS (Param_Type, Name_uRead))
1342 or else No (TSS (Param_Type, Name_uWrite))
1345 ("limited formal must have Read and Write attributes",
1351 -- Check next parameter in this subprogram
1357 Next_Elmt (Subprogram);
1360 -- Now this is an RCI unit access-to-class-wide-limited-private type
1361 -- declaration. Set the type entity to be Is_Remote_Call_Interface to
1362 -- optimize later checks by avoiding tree traversal to find out if this
1363 -- entity is inside an RCI unit.
1365 Set_Is_Remote_Call_Interface (T);
1367 end Validate_Remote_Access_Object_Type_Declaration;
1369 -----------------------------------------------
1370 -- Validate_Remote_Access_To_Class_Wide_Type --
1371 -----------------------------------------------
1373 procedure Validate_Remote_Access_To_Class_Wide_Type (N : Node_Id) is
1374 K : constant Node_Kind := Nkind (N);
1375 PK : constant Node_Kind := Nkind (Parent (N));
1379 -- This subprogram enforces the checks in (RM E.2.2(8)) for
1380 -- certain uses of class-wide limited private types.
1382 -- Storage_Pool and Storage_Size are not defined for such types
1384 -- The expected type of allocator must not not be such a type.
1386 -- The actual parameter of generic instantiation must not
1387 -- be such a type if the formal parameter is of an access type.
1389 -- On entry, there are five cases
1391 -- 1. called from sem_attr Analyze_Attribute where attribute
1392 -- name is either Storage_Pool or Storage_Size.
1394 -- 2. called from exp_ch4 Expand_N_Allocator
1396 -- 3. called from sem_ch12 Analyze_Associations
1398 -- 4. called from sem_ch4 Analyze_Explicit_Dereference
1400 -- 5. called from sem_res Resolve_Actuals
1402 if K = N_Attribute_Reference then
1403 E := Etype (Prefix (N));
1405 if Is_Remote_Access_To_Class_Wide_Type (E) then
1406 Error_Msg_N ("incorrect attribute of remote operand", N);
1410 elsif K = N_Allocator then
1413 if Is_Remote_Access_To_Class_Wide_Type (E) then
1414 Error_Msg_N ("incorrect expected remote type of allocator", N);
1418 elsif K in N_Has_Entity then
1421 if Is_Remote_Access_To_Class_Wide_Type (E) then
1422 Error_Msg_N ("incorrect remote type generic actual", N);
1426 -- This subprogram also enforces the checks in E.2.2(13).
1427 -- A value of such type must not be dereferenced unless as a
1428 -- controlling operand of a dispatching call.
1430 elsif K = N_Explicit_Dereference
1431 and then (Comes_From_Source (N)
1432 or else (Nkind (Original_Node (N)) = N_Selected_Component
1433 and then Comes_From_Source (Original_Node (N))))
1435 E := Etype (Prefix (N));
1437 -- If the class-wide type is not a remote one, the restrictions
1440 if not Is_Remote_Access_To_Class_Wide_Type (E) then
1444 -- If we have a true dereference that comes from source and that
1445 -- is a controlling argument for a dispatching call, accept it.
1447 if K = N_Explicit_Dereference
1448 and then Is_Actual_Parameter (N)
1449 and then Is_Controlling_Actual (N)
1454 -- If we are just within a procedure or function call and the
1455 -- dereference has not been analyzed, return because this
1456 -- procedure will be called again from sem_res Resolve_Actuals.
1458 if Is_Actual_Parameter (N)
1459 and then not Analyzed (N)
1464 -- The following is to let the compiler generated tags check
1465 -- pass through without error message. This is a bit kludgy
1466 -- isn't there some better way of making this exclusion ???
1468 if (PK = N_Selected_Component
1469 and then Present (Parent (Parent (N)))
1470 and then Nkind (Parent (Parent (N))) = N_Op_Ne)
1471 or else (PK = N_Unchecked_Type_Conversion
1472 and then Present (Parent (Parent (N)))
1474 Nkind (Parent (Parent (N))) = N_Selected_Component)
1479 -- The following code is needed for expansion of RACW Write
1480 -- attribute, since such expressions can appear in the expanded
1483 if not Comes_From_Source (N)
1486 or else PK = N_Attribute_Reference
1488 (PK = N_Type_Conversion
1489 and then Present (Parent (N))
1490 and then Present (Parent (Parent (N)))
1492 Nkind (Parent (Parent (N))) = N_Selected_Component))
1497 Error_Msg_N ("incorrect remote type dereference", N);
1499 end Validate_Remote_Access_To_Class_Wide_Type;
1501 -----------------------------------------------
1502 -- Validate_Remote_Access_To_Subprogram_Type --
1503 -----------------------------------------------
1505 procedure Validate_Remote_Access_To_Subprogram_Type (N : Node_Id) is
1506 Type_Def : constant Node_Id := Type_Definition (N);
1507 Current_Parameter : Node_Id;
1510 if Present (Parameter_Specifications (Type_Def)) then
1511 Current_Parameter := First (Parameter_Specifications (Type_Def));
1512 while Present (Current_Parameter) loop
1513 if Nkind (Parameter_Type (Current_Parameter)) =
1517 ("remote access to subprogram type declaration contains",
1520 ("\parameter of an anonymous access type", Current_Parameter);
1523 Current_Parameter := Next (Current_Parameter);
1526 end Validate_Remote_Access_To_Subprogram_Type;
1528 ------------------------------------------
1529 -- Validate_Remote_Type_Type_Conversion --
1530 ------------------------------------------
1532 procedure Validate_Remote_Type_Type_Conversion (N : Node_Id) is
1533 S : constant Entity_Id := Etype (N);
1534 E : constant Entity_Id := Etype (Expression (N));
1537 -- This test is required in the case where a conversion appears
1538 -- inside a normal package, it does not necessarily have to be
1539 -- inside an RCI, Remote_Types unit (RM E.2.2(9,12)).
1541 if Is_Remote_Access_To_Subprogram_Type (E)
1542 and then not Is_Remote_Access_To_Subprogram_Type (S)
1544 Error_Msg_N ("incorrect conversion of remote operand", N);
1547 elsif Is_Remote_Access_To_Class_Wide_Type (E)
1548 and then not Is_Remote_Access_To_Class_Wide_Type (S)
1550 Error_Msg_N ("incorrect conversion of remote operand", N);
1554 -- If a local access type is converted into a RACW type, then the
1555 -- current unit has a pointer that may now be exported to another
1558 if Is_Remote_Access_To_Class_Wide_Type (S)
1559 and then not Is_Remote_Access_To_Class_Wide_Type (E)
1561 Set_Has_RACW (Current_Sem_Unit);
1563 end Validate_Remote_Type_Type_Conversion;
1565 -------------------------------
1566 -- Validate_RT_RAT_Component --
1567 -------------------------------
1569 procedure Validate_RT_RAT_Component (N : Node_Id) is
1570 Spec : constant Node_Id := Specification (N);
1571 Name_U : constant Entity_Id := Defining_Entity (Spec);
1573 First_Priv_Ent : constant Entity_Id := First_Private_Entity (Name_U);
1574 In_Visible_Part : Boolean := True;
1577 if not Is_Remote_Types (Name_U) then
1581 Typ := First_Entity (Name_U);
1582 while Present (Typ) loop
1583 if In_Visible_Part and then Typ = First_Priv_Ent then
1584 In_Visible_Part := False;
1587 if Comes_From_Source (Typ)
1588 and then Is_Type (Typ)
1589 and then (In_Visible_Part or else Has_Private_Declaration (Typ))
1591 if Missing_Read_Write_Attributes (Typ) then
1592 if Is_Non_Remote_Access_Type (Typ) then
1594 ("non-remote access type without user-defined Read " &
1595 "and Write attributes", Typ);
1598 ("record type containing a component of a " &
1599 "non-remote access", Typ);
1601 ("\type without Read and Write attributes " &
1602 "('R'M E.2.2(8))", Typ);
1609 end Validate_RT_RAT_Component;
1611 -----------------------------------------
1612 -- Validate_SP_Access_Object_Type_Decl --
1613 -----------------------------------------
1615 procedure Validate_SP_Access_Object_Type_Decl (T : Entity_Id) is
1616 Direct_Designated_Type : Entity_Id;
1618 function Has_Entry_Declarations (E : Entity_Id) return Boolean;
1619 -- Return true if the protected type designated by T has
1620 -- entry declarations.
1622 function Has_Entry_Declarations (E : Entity_Id) return Boolean is
1626 if Nkind (Parent (E)) = N_Protected_Type_Declaration then
1627 Ety := First_Entity (E);
1628 while Present (Ety) loop
1629 if Ekind (Ety) = E_Entry then
1638 end Has_Entry_Declarations;
1640 -- Start of processing for Validate_SP_Access_Object_Type_Decl
1643 -- We are called from Sem_Ch3.Analyze_Type_Declaration, and the
1644 -- Nkind of the given entity is N_Access_To_Object_Definition.
1646 if not Comes_From_Source (T)
1647 or else not In_Shared_Passive_Unit
1648 or else In_Subprogram_Task_Protected_Unit
1653 -- Check Shared Passive unit. It should not contain the declaration
1654 -- of an access-to-object type whose designated type is a class-wide
1655 -- type, task type or protected type with entry (RM E.2.1(7)).
1657 Direct_Designated_Type := Designated_Type (T);
1659 if Ekind (Direct_Designated_Type) = E_Class_Wide_Type then
1661 ("invalid access-to-class-wide type in shared passive unit", T);
1664 elsif Ekind (Direct_Designated_Type) in Task_Kind then
1666 ("invalid access-to-task type in shared passive unit", T);
1669 elsif Ekind (Direct_Designated_Type) in Protected_Kind
1670 and then Has_Entry_Declarations (Direct_Designated_Type)
1673 ("invalid access-to-protected type in shared passive unit", T);
1676 end Validate_SP_Access_Object_Type_Decl;
1678 ---------------------------------
1679 -- Validate_Static_Object_Name --
1680 ---------------------------------
1682 procedure Validate_Static_Object_Name (N : Node_Id) is
1685 function Is_Primary (N : Node_Id) return Boolean;
1686 -- Determine whether node is syntactically a primary in an expression.
1688 function Is_Primary (N : Node_Id) return Boolean is
1689 K : constant Node_Kind := Nkind (Parent (N));
1694 when N_Op | N_In | N_Not_In =>
1698 | N_Component_Association
1699 | N_Index_Or_Discriminant_Constraint =>
1702 when N_Attribute_Reference =>
1703 return Attribute_Name (Parent (N)) /= Name_Address
1704 and then Attribute_Name (Parent (N)) /= Name_Access
1705 and then Attribute_Name (Parent (N)) /= Name_Unchecked_Access
1707 Attribute_Name (Parent (N)) /= Name_Unrestricted_Access;
1709 when N_Indexed_Component =>
1710 return (N /= Prefix (Parent (N))
1711 or else Is_Primary (Parent (N)));
1713 when N_Qualified_Expression | N_Type_Conversion =>
1714 return Is_Primary (Parent (N));
1716 when N_Assignment_Statement | N_Object_Declaration =>
1717 return (N = Expression (Parent (N)));
1719 when N_Selected_Component =>
1720 return Is_Primary (Parent (N));
1727 -- Start of processing for Validate_Static_Object_Name
1730 if not In_Preelaborated_Unit
1731 or else not Comes_From_Source (N)
1732 or else In_Subprogram_Or_Concurrent_Unit
1733 or else Ekind (Current_Scope) = E_Block
1737 -- Filter out cases where primary is default in a component
1738 -- declaration, discriminant specification, or actual in a record
1739 -- type initialization call.
1741 -- Initialization call of internal types.
1743 elsif Nkind (Parent (N)) = N_Procedure_Call_Statement then
1745 if Present (Parent (Parent (N)))
1746 and then Nkind (Parent (Parent (N))) = N_Freeze_Entity
1751 if Nkind (Name (Parent (N))) = N_Identifier
1752 and then not Comes_From_Source (Entity (Name (Parent (N))))
1758 -- Error if the name is a primary in an expression. The parent must not
1759 -- be an operator, or a selected component or an indexed component that
1760 -- is itself a primary. Entities that are actuals do not need to be
1761 -- checked, because the call itself will be diagnosed.
1764 and then (not Inside_A_Generic
1765 or else Present (Enclosing_Generic_Body (N)))
1767 if Ekind (Entity (N)) = E_Variable then
1768 Error_Msg_N ("non-static object name in preelaborated unit", N);
1770 -- We take the view that a constant defined in another preelaborated
1771 -- unit is preelaborable, even though it may have a private type and
1772 -- thus appear non-static in a client. This must be the intent of
1773 -- the language, but currently is an RM gap.
1775 elsif Ekind (Entity (N)) = E_Constant
1776 and then not Is_Static_Expression (N)
1780 if Is_Internal_File_Name (Unit_File_Name (Get_Source_Unit (N)))
1782 Enclosing_Lib_Unit_Node (N) /= Enclosing_Lib_Unit_Node (E)
1783 and then (Is_Preelaborated (Scope (E))
1784 or else Is_Pure (Scope (E))
1785 or else (Present (Renamed_Object (E))
1787 Is_Entity_Name (Renamed_Object (E))
1790 (Scope (Renamed_Object (E)))
1793 (Renamed_Object (E))))))
1797 Error_Msg_N ("non-static constant in preelaborated unit", N);
1801 end Validate_Static_Object_Name;