1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Atree; use Atree;
28 with Debug; use Debug;
29 with Einfo; use Einfo;
30 with Elists; use Elists;
31 with Errout; use Errout;
32 with Exp_Tss; use Exp_Tss;
33 with Fname; use Fname;
35 with Nlists; use Nlists;
38 with Sem_Eval; use Sem_Eval;
39 with Sem_Util; use Sem_Util;
40 with Sinfo; use Sinfo;
41 with Snames; use Snames;
42 with Stand; use Stand;
44 package body Sem_Cat is
46 -----------------------
47 -- Local Subprograms --
48 -----------------------
50 procedure Check_Categorization_Dependencies
51 (Unit_Entity : Entity_Id;
52 Depended_Entity : Entity_Id;
54 Is_Subunit : Boolean);
55 -- This procedure checks that the categorization of a lib unit and that
56 -- of the depended unit satisfy dependency restrictions.
57 -- The depended_entity can be the entity in a with_clause item, in which
58 -- case Info_Node denotes that item. The depended_entity can also be the
59 -- parent unit of a child unit, in which case Info_Node is the declaration
60 -- of the child unit. The error message is posted on Info_Node, and is
61 -- specialized if Is_Subunit is true.
63 procedure Check_Non_Static_Default_Expr
66 -- Iterate through the component list of a record definition, check
67 -- that no component is declared with a nonstatic default value.
68 -- If a nonstatic default exists, report an error on Obj_Decl.
70 -- Iterate through the component list of a record definition, check
71 -- that no component is declared with a non-static default value.
73 function Missing_Read_Write_Attributes (E : Entity_Id) return Boolean;
74 -- Return True if the entity or one of its subcomponent is an access
75 -- type which does not have user-defined Read and Write attribute.
77 function In_RCI_Declaration (N : Node_Id) return Boolean;
78 -- Determines if a declaration is within the visible part of a Remote
79 -- Call Interface compilation unit, for semantic checking purposes only,
80 -- (returns false within an instance and within the package body).
82 function In_RT_Declaration return Boolean;
83 -- Determines if current scope is within a Remote Types compilation unit,
84 -- for semantic checking purposes.
86 function Is_Non_Remote_Access_Type (E : Entity_Id) return Boolean;
87 -- Returns true if the entity is a non-remote access type
89 function In_Shared_Passive_Unit return Boolean;
90 -- Determines if current scope is within a Shared Passive compilation unit
92 function Static_Discriminant_Expr (L : List_Id) return Boolean;
93 -- Iterate through the list of discriminants to check if any of them
94 -- contains non-static default expression, which is a violation in
95 -- a preelaborated library unit.
97 procedure Validate_Remote_Access_Object_Type_Declaration (T : Entity_Id);
98 -- Check validity of declaration if RCI or RT unit. It should not contain
99 -- the declaration of an access-to-object type unless it is a
100 -- general access type that designates a class-wide limited
101 -- private type. There are also constraints about the primitive
102 -- subprograms of the class-wide type. RM E.2 (9, 13, 14)
104 function Is_Recursively_Limited_Private (E : Entity_Id) return Boolean;
105 -- Return True if E is a limited private type, or if E is a private
106 -- extension of a type whose parent verifies this property (hence the
107 -- recursive keyword).
109 ---------------------------------------
110 -- Check_Categorization_Dependencies --
111 ---------------------------------------
113 procedure Check_Categorization_Dependencies
114 (Unit_Entity : Entity_Id;
115 Depended_Entity : Entity_Id;
117 Is_Subunit : Boolean)
119 N : constant Node_Id := Info_Node;
121 type Categorization is
122 (Pure, Shared_Passive, Remote_Types,
123 Remote_Call_Interface, Pre_Elaborated, Normal);
125 Unit_Category : Categorization;
126 With_Category : Categorization;
128 function Get_Categorization (E : Entity_Id) return Categorization;
129 -- Check categorization flags from entity, and return in the form
130 -- of a corresponding enumeration value.
132 ------------------------
133 -- Get_Categorization --
134 ------------------------
136 function Get_Categorization (E : Entity_Id) return Categorization is
138 if Is_Preelaborated (E) then
139 return Pre_Elaborated;
140 elsif Is_Pure (E) then
142 elsif Is_Shared_Passive (E) then
143 return Shared_Passive;
144 elsif Is_Remote_Types (E) then
146 elsif Is_Remote_Call_Interface (E) then
147 return Remote_Call_Interface;
151 end Get_Categorization;
153 -- Start of processing for Check_Categorization_Dependencies
156 -- Intrinsic subprograms are preelaborated, so do not impose any
157 -- categorization dependencies.
159 if Is_Intrinsic_Subprogram (Depended_Entity) then
163 Unit_Category := Get_Categorization (Unit_Entity);
164 With_Category := Get_Categorization (Depended_Entity);
166 if With_Category > Unit_Category then
167 if (Unit_Category = Remote_Types
168 or else Unit_Category = Remote_Call_Interface)
169 and then In_Package_Body (Unit_Entity)
173 -- Subunit error case. In GNAT mode, this is only a warning to allow
174 -- it to be judiciously turned off. Otherwise it is a real error.
176 elsif Is_Subunit then
179 ("?subunit cannot depend on& " &
180 "(parent has wrong categorization)", N, Depended_Entity);
183 ("subunit cannot depend on& " &
184 "(parent has wrong categorization)", N, Depended_Entity);
187 -- Normal error case. In GNAT mode, this is only a warning to allow
188 -- it to be judiciously turned off. Otherwise it is a real error.
193 ("?current unit cannot depend on& " &
194 "(wrong categorization)", N, Depended_Entity);
197 ("current unit cannot depend on& " &
198 "(wrong categorization)", N, Depended_Entity);
203 end Check_Categorization_Dependencies;
205 -----------------------------------
206 -- Check_Non_Static_Default_Expr --
207 -----------------------------------
209 procedure Check_Non_Static_Default_Expr
214 Component_Decl : Node_Id;
217 if Nkind (Type_Def) = N_Derived_Type_Definition then
218 Recdef := Record_Extension_Part (Type_Def);
228 -- Check that component declarations do not involve:
230 -- a. a non-static default expression, where the object is
231 -- declared to be default initialized.
233 -- b. a dynamic Itype (discriminants and constraints)
235 if Null_Present (Recdef) then
238 Component_Decl := First (Component_Items (Component_List (Recdef)));
241 while Present (Component_Decl)
242 and then Nkind (Component_Decl) = N_Component_Declaration
244 if Present (Expression (Component_Decl))
245 and then Nkind (Expression (Component_Decl)) /= N_Null
246 and then not Is_Static_Expression (Expression (Component_Decl))
248 Error_Msg_Sloc := Sloc (Component_Decl);
250 ("object in preelaborated unit has non-static default#",
253 -- Fix this later ???
255 -- elsif Has_Dynamic_Itype (Component_Decl) then
257 -- ("dynamic type discriminant," &
258 -- " constraint in preelaborated unit",
262 Next (Component_Decl);
264 end Check_Non_Static_Default_Expr;
266 ---------------------------
267 -- In_Preelaborated_Unit --
268 ---------------------------
270 function In_Preelaborated_Unit return Boolean is
271 Unit_Entity : constant Entity_Id := Current_Scope;
272 Unit_Kind : constant Node_Kind :=
273 Nkind (Unit (Cunit (Current_Sem_Unit)));
276 -- There are no constraints on body of remote_call_interface or
277 -- remote_types packages..
279 return (Unit_Entity /= Standard_Standard)
280 and then (Is_Preelaborated (Unit_Entity)
281 or else Is_Pure (Unit_Entity)
282 or else Is_Shared_Passive (Unit_Entity)
284 ((Is_Remote_Types (Unit_Entity)
285 or else Is_Remote_Call_Interface (Unit_Entity))
286 and then Ekind (Unit_Entity) = E_Package
287 and then Unit_Kind /= N_Package_Body
288 and then not In_Package_Body (Unit_Entity)
289 and then not In_Instance));
290 end In_Preelaborated_Unit;
296 function In_Pure_Unit return Boolean is
298 return Is_Pure (Current_Scope);
301 ------------------------
302 -- In_RCI_Declaration --
303 ------------------------
305 function In_RCI_Declaration (N : Node_Id) return Boolean is
306 Unit_Entity : constant Entity_Id := Current_Scope;
307 Unit_Kind : constant Node_Kind :=
308 Nkind (Unit (Cunit (Current_Sem_Unit)));
311 -- There are no restrictions on the private part or body
314 return Is_Remote_Call_Interface (Unit_Entity)
315 and then (Ekind (Unit_Entity) = E_Package
316 or else Ekind (Unit_Entity) = E_Generic_Package)
317 and then Unit_Kind /= N_Package_Body
318 and then List_Containing (N) =
320 (Specification (Unit_Declaration_Node (Unit_Entity)))
321 and then not In_Package_Body (Unit_Entity)
322 and then not In_Instance;
323 end In_RCI_Declaration;
325 -----------------------
326 -- In_RT_Declaration --
327 -----------------------
329 function In_RT_Declaration return Boolean is
330 Unit_Entity : constant Entity_Id := Current_Scope;
331 Unit_Kind : constant Node_Kind :=
332 Nkind (Unit (Cunit (Current_Sem_Unit)));
335 -- There are no restrictions on the body of a Remote Types unit.
337 return Is_Remote_Types (Unit_Entity)
338 and then (Ekind (Unit_Entity) = E_Package
339 or else Ekind (Unit_Entity) = E_Generic_Package)
340 and then Unit_Kind /= N_Package_Body
341 and then not In_Package_Body (Unit_Entity)
342 and then not In_Instance;
343 end In_RT_Declaration;
345 ----------------------------
346 -- In_Shared_Passive_Unit --
347 ----------------------------
349 function In_Shared_Passive_Unit return Boolean is
350 Unit_Entity : constant Entity_Id := Current_Scope;
353 return Is_Shared_Passive (Unit_Entity);
354 end In_Shared_Passive_Unit;
356 ---------------------------------------
357 -- In_Subprogram_Task_Protected_Unit --
358 ---------------------------------------
360 function In_Subprogram_Task_Protected_Unit return Boolean is
364 -- The following is to verify that a declaration is inside
365 -- subprogram, generic subprogram, task unit, protected unit.
366 -- Used to validate if a lib. unit is Pure. RM 10.2.1(16).
368 -- Use scope chain to check successively outer scopes
374 Is_Generic_Subprogram (E)
376 Is_Concurrent_Type (E)
380 elsif E = Standard_Standard then
386 end In_Subprogram_Task_Protected_Unit;
388 -------------------------------
389 -- Is_Non_Remote_Access_Type --
390 -------------------------------
392 function Is_Non_Remote_Access_Type (E : Entity_Id) return Boolean is
394 return Is_Access_Type (E)
395 and then not Is_Remote_Access_To_Class_Wide_Type (E)
396 and then not Is_Remote_Access_To_Subprogram_Type (E);
397 end Is_Non_Remote_Access_Type;
399 ------------------------------------
400 -- Is_Recursively_Limited_Private --
401 ------------------------------------
403 function Is_Recursively_Limited_Private (E : Entity_Id) return Boolean is
404 P : constant Node_Id := Parent (E);
407 if Nkind (P) = N_Private_Type_Declaration
408 and then Is_Limited_Record (E)
411 elsif Nkind (P) = N_Private_Extension_Declaration then
412 return Is_Recursively_Limited_Private (Etype (E));
413 elsif Nkind (P) = N_Formal_Type_Declaration
414 and then Ekind (E) = E_Record_Type_With_Private
415 and then Is_Generic_Type (E)
416 and then Is_Limited_Record (E)
422 end Is_Recursively_Limited_Private;
424 ----------------------------------
425 -- Missing_Read_Write_Attribute --
426 ----------------------------------
428 function Missing_Read_Write_Attributes (E : Entity_Id) return Boolean is
429 Component : Entity_Id;
430 Component_Type : Entity_Id;
432 function Has_Read_Write_Attributes (E : Entity_Id) return Boolean;
433 -- Return True if entity has Read and Write attributes
435 -------------------------------
436 -- Has_Read_Write_Attributes --
437 -------------------------------
439 function Has_Read_Write_Attributes (E : Entity_Id) return Boolean is
440 Rep_Item : Node_Id := First_Rep_Item (E);
441 Read_Attribute : Boolean := False;
442 Write_Attribute : Boolean := False;
445 -- We start from the declaration node and then loop until the end
446 -- of the list until we find those two attribute definition clauses.
448 while Present (Rep_Item) loop
449 if Chars (Rep_Item) = Name_Read then
450 Read_Attribute := True;
451 elsif Chars (Rep_Item) = Name_Write then
452 Write_Attribute := True;
455 if Read_Attribute and Write_Attribute then
459 Next_Rep_Item (Rep_Item);
463 end Has_Read_Write_Attributes;
465 -- Start of processing for Missing_Read_Write_Attributes
468 if Has_Read_Write_Attributes (E) then
470 elsif Is_Non_Remote_Access_Type (E) then
474 if Is_Record_Type (E) then
475 Component := First_Entity (E);
476 while Present (Component) loop
477 Component_Type := Etype (Component);
479 if (Is_Non_Remote_Access_Type (Component_Type)
480 or else Is_Record_Type (Component_Type))
481 and then Missing_Read_Write_Attributes (Component_Type)
486 Next_Entity (Component);
491 end Missing_Read_Write_Attributes;
493 -------------------------------------
494 -- Set_Categorization_From_Pragmas --
495 -------------------------------------
497 procedure Set_Categorization_From_Pragmas (N : Node_Id) is
498 P : constant Node_Id := Parent (N);
499 S : constant Entity_Id := Current_Scope;
501 procedure Set_Parents (Visibility : Boolean);
502 -- If this is a child instance, the parents are not immediately
503 -- visible during analysis. Make them momentarily visible so that
504 -- the argument of the pragma can be resolved properly, and reset
507 procedure Set_Parents (Visibility : Boolean) is
508 Par : Entity_Id := Scope (S);
511 while Present (Par) and then Par /= Standard_Standard loop
512 Set_Is_Immediately_Visible (Par, Visibility);
518 -- Deal with categorization pragmas in Pragmas of Compilation_Unit.
519 -- The purpose is to set categorization flags before analyzing the
520 -- unit itself, so as to diagnose violations of categorization as
521 -- we process each declaration, even though the pragma appears after
524 if Nkind (P) /= N_Compilation_Unit then
529 PN : Node_Id := First (Pragmas_After (Aux_Decls_Node (P)));
534 and then Is_Generic_Instance (S)
539 while Present (PN) loop
541 -- Skip implicit types that may have been introduced by
542 -- previous analysis.
544 if Nkind (PN) = N_Pragma then
546 case Get_Pragma_Id (Chars (PN)) is
547 when Pragma_All_Calls_Remote |
548 Pragma_Preelaborate |
550 Pragma_Remote_Call_Interface |
551 Pragma_Remote_Types |
552 Pragma_Shared_Passive => Analyze (PN);
560 and then Is_Generic_Instance (S)
566 end Set_Categorization_From_Pragmas;
568 -----------------------------------
569 -- Set_Categorization_From_Scope --
570 -----------------------------------
572 procedure Set_Categorization_From_Scope (E : Entity_Id; Scop : Entity_Id) is
573 Declaration : Node_Id := Empty;
574 Specification : Node_Id := Empty;
578 Is_Pure (Scop) and then Is_Library_Level_Entity (E));
580 if not Is_Remote_Call_Interface (E) then
581 if Ekind (E) in Subprogram_Kind then
582 Declaration := Unit_Declaration_Node (E);
585 or else Nkind (Declaration) = N_Subprogram_Body
586 or else Nkind (Declaration) = N_Subprogram_Renaming_Declaration
588 Specification := Corresponding_Spec (Declaration);
592 -- A subprogram body or renaming-as-body is a remote call
593 -- interface if it serves as the completion of a subprogram
594 -- declaration that is a remote call interface.
596 if Nkind (Specification) in N_Entity then
597 Set_Is_Remote_Call_Interface
598 (E, Is_Remote_Call_Interface (Specification));
600 -- A subprogram declaration is a remote call interface when it is
601 -- declared within the visible part of, or declared by, a library
602 -- unit declaration that is a remote call interface.
605 Set_Is_Remote_Call_Interface
606 (E, Is_Remote_Call_Interface (Scop)
607 and then not (In_Private_Part (Scop)
608 or else In_Package_Body (Scop)));
612 Set_Is_Remote_Types (E, Is_Remote_Types (Scop));
613 end Set_Categorization_From_Scope;
615 ------------------------------
616 -- Static_Discriminant_Expr --
617 ------------------------------
619 -- We need to accomodate a Why_Not_Static call somehow here ???
621 function Static_Discriminant_Expr (L : List_Id) return Boolean is
622 Discriminant_Spec : Node_Id;
625 Discriminant_Spec := First (L);
626 while Present (Discriminant_Spec) loop
627 if Present (Expression (Discriminant_Spec))
628 and then not Is_Static_Expression (Expression (Discriminant_Spec))
633 Next (Discriminant_Spec);
637 end Static_Discriminant_Expr;
639 --------------------------------------
640 -- Validate_Access_Type_Declaration --
641 --------------------------------------
643 procedure Validate_Access_Type_Declaration (T : Entity_Id; N : Node_Id) is
644 Def : constant Node_Id := Type_Definition (N);
649 -- Access to subprogram case
651 when N_Access_To_Subprogram_Definition =>
653 -- A pure library_item must not contain the declaration of a
654 -- named access type, except within a subprogram, generic
655 -- subprogram, task unit, or protected unit (RM 10.2.1(16)).
657 -- This test is skipped in Ada 2005 (see AI-366)
659 if Ada_Version < Ada_05
660 and then Comes_From_Source (T)
661 and then In_Pure_Unit
662 and then not In_Subprogram_Task_Protected_Unit
664 Error_Msg_N ("named access type not allowed in pure unit", T);
667 -- Access to object case
669 when N_Access_To_Object_Definition =>
670 if Comes_From_Source (T)
671 and then In_Pure_Unit
672 and then not In_Subprogram_Task_Protected_Unit
674 -- We can't give the message yet, since the type is not frozen
675 -- and in Ada 2005 mode, access types are allowed in pure units
676 -- if the type has no storage pool (see AI-366). So we set a
677 -- flag which will be checked at freeze time.
679 Set_Is_Pure_Unit_Access_Type (T);
682 -- Check for RCI or RT unit type declaration. It should not
683 -- contain the declaration of an access-to-object type unless it
684 -- is a general access type that designates a class-wide limited
685 -- private type. There are also constraints about the primitive
686 -- subprograms of the class-wide type.
688 Validate_Remote_Access_Object_Type_Declaration (T);
690 -- Check for shared passive unit type declaration. It should
691 -- not contain the declaration of access to class wide type,
692 -- access to task type and access to protected type with entry.
694 Validate_SP_Access_Object_Type_Decl (T);
700 -- Set categorization flag from package on entity as well, to allow
701 -- easy checks later on for required validations of RCI or RT units.
702 -- This is only done for entities that are in the original source.
704 if Comes_From_Source (T)
705 and then not (In_Package_Body (Scope (T))
706 or else In_Private_Part (Scope (T)))
708 Set_Is_Remote_Call_Interface
709 (T, Is_Remote_Call_Interface (Scope (T)));
711 (T, Is_Remote_Types (Scope (T)));
713 end Validate_Access_Type_Declaration;
715 ----------------------------
716 -- Validate_Ancestor_Part --
717 ----------------------------
719 procedure Validate_Ancestor_Part (N : Node_Id) is
720 A : constant Node_Id := Ancestor_Part (N);
721 T : constant Entity_Id := Entity (A);
724 if In_Preelaborated_Unit
725 and then not In_Subprogram_Or_Concurrent_Unit
726 and then (not Inside_A_Generic
727 or else Present (Enclosing_Generic_Body (N)))
729 -- We relax the restriction of 10.2.1(9) within GNAT
730 -- units to allow packages such as Ada.Strings.Unbounded
731 -- to be implemented (i.p., Null_Unbounded_String).
732 -- (There are ACVC tests that check that the restriction
733 -- is enforced, but note that AI-161, once approved,
734 -- will relax the restriction prohibiting default-
735 -- initialized objects of private and controlled
738 if Is_Private_Type (T)
739 and then not Is_Internal_File_Name
740 (Unit_File_Name (Get_Source_Unit (N)))
743 ("private ancestor type not allowed in preelaborated unit", A);
745 elsif Is_Record_Type (T) then
746 if Nkind (Parent (T)) = N_Full_Type_Declaration then
747 Check_Non_Static_Default_Expr
748 (Type_Definition (Parent (T)), A);
752 end Validate_Ancestor_Part;
754 ----------------------------------------
755 -- Validate_Categorization_Dependency --
756 ----------------------------------------
758 procedure Validate_Categorization_Dependency
762 K : constant Node_Kind := Nkind (N);
763 P : Node_Id := Parent (N);
765 Is_Subunit : constant Boolean := Nkind (P) = N_Subunit;
768 -- Only validate library units and subunits. For subunits, checks
769 -- concerning withed units apply to the parent compilation unit.
776 and then not Is_Compilation_Unit (U)
777 and then not Is_Child_Unit (U)
784 if Nkind (P) /= N_Compilation_Unit then
788 -- Body of RCI unit does not need validation.
790 if Is_Remote_Call_Interface (E)
791 and then (Nkind (N) = N_Package_Body
792 or else Nkind (N) = N_Subprogram_Body)
797 -- Ada 2005 (AI-50217): Process explicit non-limited with_clauses
801 Entity_Of_Withed : Entity_Id;
804 Item := First (Context_Items (P));
806 while Present (Item) loop
807 if Nkind (Item) = N_With_Clause
808 and then not (Implicit_With (Item)
809 or else Limited_Present (Item))
811 Entity_Of_Withed := Entity (Name (Item));
812 Check_Categorization_Dependencies
813 (U, Entity_Of_Withed, Item, Is_Subunit);
820 -- Child depends on parent; therefore parent should also
821 -- be categorized and satify the dependency hierarchy.
823 -- Check if N is a child spec.
825 if (K in N_Generic_Declaration or else
826 K in N_Generic_Instantiation or else
827 K in N_Generic_Renaming_Declaration or else
828 K = N_Package_Declaration or else
829 K = N_Package_Renaming_Declaration or else
830 K = N_Subprogram_Declaration or else
831 K = N_Subprogram_Renaming_Declaration)
832 and then Present (Parent_Spec (N))
834 Check_Categorization_Dependencies (E, Scope (E), N, False);
836 -- Verify that public child of an RCI library unit
837 -- must also be an RCI library unit (RM E.2.3(15)).
839 if Is_Remote_Call_Interface (Scope (E))
840 and then not Private_Present (P)
841 and then not Is_Remote_Call_Interface (E)
843 Error_Msg_N ("public child of rci unit must also be rci unit", N);
846 end Validate_Categorization_Dependency;
848 --------------------------------
849 -- Validate_Controlled_Object --
850 --------------------------------
852 procedure Validate_Controlled_Object (E : Entity_Id) is
854 -- For now, never apply this check for internal GNAT units, since we
855 -- have a number of cases in the library where we are stuck with objects
856 -- of this type, and the RM requires Preelaborate.
858 -- For similar reasons, we only do this check for source entities, since
859 -- we generate entities of this type in some situations.
861 -- Note that the 10.2.1(9) restrictions are not relevant to us anyway.
862 -- We have to enforce them for RM compatibility, but we have no trouble
863 -- accepting these objects and doing the right thing. Note that there is
864 -- no requirement that Preelaborate not actually generate any code!
866 if In_Preelaborated_Unit
867 and then not Debug_Flag_PP
868 and then Comes_From_Source (E)
870 Is_Internal_File_Name (Unit_File_Name (Get_Source_Unit (E)))
871 and then (not Inside_A_Generic
872 or else Present (Enclosing_Generic_Body (E)))
873 and then not Is_Protected_Type (Etype (E))
876 ("library level controlled object not allowed in " &
877 "preelaborated unit", E);
879 end Validate_Controlled_Object;
881 --------------------------------------
882 -- Validate_Null_Statement_Sequence --
883 --------------------------------------
885 procedure Validate_Null_Statement_Sequence (N : Node_Id) is
889 if In_Preelaborated_Unit then
890 Item := First (Statements (Handled_Statement_Sequence (N)));
892 while Present (Item) loop
893 if Nkind (Item) /= N_Label
894 and then Nkind (Item) /= N_Null_Statement
896 -- In GNAT mode, this is a warning, allowing the run-time
897 -- to judiciously bypass this error condition.
901 ("?statements not allowed in preelaborated unit", Item);
904 ("statements not allowed in preelaborated unit", Item);
913 end Validate_Null_Statement_Sequence;
915 ---------------------------------
916 -- Validate_Object_Declaration --
917 ---------------------------------
919 procedure Validate_Object_Declaration (N : Node_Id) is
920 Id : constant Entity_Id := Defining_Identifier (N);
921 E : constant Node_Id := Expression (N);
922 Odf : constant Node_Id := Object_Definition (N);
923 T : constant Entity_Id := Etype (Id);
926 -- Verify that any access to subprogram object does not have in its
927 -- subprogram profile access type parameters or limited parameters
928 -- without Read and Write attributes (E.2.3(13)).
930 Validate_RCI_Subprogram_Declaration (N);
932 -- Check that if we are in preelaborated elaboration code, then we
933 -- do not have an instance of a default initialized private, task or
934 -- protected object declaration which would violate (RM 10.2.1(9)).
935 -- Note that constants are never default initialized (and the test
936 -- below also filters out deferred constants). A variable is default
937 -- initialized if it does *not* have an initialization expression.
939 -- Filter out cases that are not declaration of a variable from source
941 if Nkind (N) /= N_Object_Declaration
942 or else Constant_Present (N)
943 or else not Comes_From_Source (Id)
948 -- Exclude generic specs from the checks (this will get rechecked
949 -- on instantiations).
952 and then not Present (Enclosing_Generic_Body (Id))
957 -- Required checks for declaration that is in a preelaborated
958 -- package and is not within some subprogram.
960 if In_Preelaborated_Unit
961 and then not In_Subprogram_Or_Concurrent_Unit
963 -- Check for default initialized variable case. Note that in
964 -- accordance with (RM B.1(24)) imported objects are not
965 -- subject to default initialization.
967 if No (E) and then not Is_Imported (Id) then
969 Ent : Entity_Id := T;
972 -- An array whose component type is a record with nonstatic
973 -- default expressions is a violation, so we get the array's
976 if Is_Array_Type (Ent) then
978 Comp_Type : Entity_Id := Component_Type (Ent);
981 while Is_Array_Type (Comp_Type) loop
982 Comp_Type := Component_Type (Comp_Type);
989 -- Object decl. that is of record type and has no default expr.
990 -- should check if there is any non-static default expression
991 -- in component decl. of the record type decl.
993 if Is_Record_Type (Ent) then
994 if Nkind (Parent (Ent)) = N_Full_Type_Declaration then
995 Check_Non_Static_Default_Expr
996 (Type_Definition (Parent (Ent)), N);
998 elsif Nkind (Odf) = N_Subtype_Indication
999 and then not Is_Array_Type (T)
1000 and then not Is_Private_Type (T)
1002 Check_Non_Static_Default_Expr (Type_Definition
1003 (Parent (Entity (Subtype_Mark (Odf)))), N);
1007 -- We relax the restriction of 10.2.1(9) within GNAT
1008 -- units. (There are ACVC tests that check that the
1009 -- restriction is enforced, but note that AI-161,
1010 -- once approved, will relax the restriction prohibiting
1011 -- default-initialized objects of private types, and
1012 -- will recommend a pragma for marking private types.)
1014 if (Is_Private_Type (Ent)
1015 or else Depends_On_Private (Ent))
1016 and then not Is_Internal_File_Name
1017 (Unit_File_Name (Get_Source_Unit (N)))
1020 ("private object not allowed in preelaborated unit", N);
1023 -- Access to Task or Protected type
1025 elsif Is_Entity_Name (Odf)
1026 and then Present (Etype (Odf))
1027 and then Is_Access_Type (Etype (Odf))
1029 Ent := Designated_Type (Etype (Odf));
1031 elsif Is_Entity_Name (Odf) then
1032 Ent := Entity (Odf);
1034 elsif Nkind (Odf) = N_Subtype_Indication then
1035 Ent := Etype (Subtype_Mark (Odf));
1038 Nkind (Odf) = N_Constrained_Array_Definition
1040 Ent := Component_Type (T);
1046 if Is_Task_Type (Ent)
1047 or else (Is_Protected_Type (Ent) and then Has_Entries (Ent))
1050 ("concurrent object not allowed in preelaborated unit",
1057 -- Non-static discriminant not allowed in preelaborayted unit
1059 if Is_Record_Type (Etype (Id)) then
1061 ET : constant Entity_Id := Etype (Id);
1062 EE : constant Entity_Id := Etype (Etype (Id));
1066 if Has_Discriminants (ET)
1067 and then Present (EE)
1071 if Nkind (PEE) = N_Full_Type_Declaration
1072 and then not Static_Discriminant_Expr
1073 (Discriminant_Specifications (PEE))
1076 ("non-static discriminant in preelaborated unit",
1084 -- A pure library_item must not contain the declaration of any
1085 -- variable except within a subprogram, generic subprogram, task
1086 -- unit or protected unit (RM 10.2.1(16)).
1089 and then not In_Subprogram_Task_Protected_Unit
1091 Error_Msg_N ("declaration of variable not allowed in pure unit", N);
1093 -- The visible part of an RCI library unit must not contain the
1094 -- declaration of a variable (RM E.1.3(9))
1096 elsif In_RCI_Declaration (N) then
1097 Error_Msg_N ("declaration of variable not allowed in rci unit", N);
1099 -- The visible part of a Shared Passive library unit must not contain
1100 -- the declaration of a variable (RM E.2.2(7))
1102 elsif In_RT_Declaration then
1104 ("variable declaration not allowed in remote types unit", N);
1107 end Validate_Object_Declaration;
1109 -------------------------------
1110 -- Validate_RCI_Declarations --
1111 -------------------------------
1113 procedure Validate_RCI_Declarations (P : Entity_Id) is
1117 E := First_Entity (P);
1118 while Present (E) loop
1119 if Comes_From_Source (E) then
1120 if Is_Limited_Type (E) then
1122 ("Limited type not allowed in rci unit", Parent (E));
1123 Explain_Limited_Type (E, Parent (E));
1125 elsif Ekind (E) = E_Generic_Function
1126 or else Ekind (E) = E_Generic_Package
1127 or else Ekind (E) = E_Generic_Procedure
1129 Error_Msg_N ("generic declaration not allowed in rci unit",
1132 elsif (Ekind (E) = E_Function
1133 or else Ekind (E) = E_Procedure)
1134 and then Has_Pragma_Inline (E)
1137 ("inlined subprogram not allowed in rci unit", Parent (E));
1139 -- Inner packages that are renamings need not be checked.
1140 -- Generic RCI packages are subject to the checks, but
1141 -- entities that come from formal packages are not part of the
1142 -- visible declarations of the package and are not checked.
1144 elsif Ekind (E) = E_Package then
1145 if Present (Renamed_Entity (E)) then
1148 elsif Ekind (P) /= E_Generic_Package
1149 or else List_Containing (Unit_Declaration_Node (E)) /=
1150 Generic_Formal_Declarations
1151 (Unit_Declaration_Node (P))
1153 Validate_RCI_Declarations (E);
1160 end Validate_RCI_Declarations;
1162 -----------------------------------------
1163 -- Validate_RCI_Subprogram_Declaration --
1164 -----------------------------------------
1166 procedure Validate_RCI_Subprogram_Declaration (N : Node_Id) is
1167 K : constant Node_Kind := Nkind (N);
1170 Param_Spec : Node_Id;
1171 Param_Type : Entity_Id;
1172 Base_Param_Type : Entity_Id;
1173 Type_Decl : Node_Id;
1174 Error_Node : Node_Id := N;
1177 -- There are two possible cases in which this procedure is called:
1179 -- 1. called from Analyze_Subprogram_Declaration.
1180 -- 2. called from Validate_Object_Declaration (access to subprogram).
1182 if not In_RCI_Declaration (N) then
1186 if K = N_Subprogram_Declaration then
1187 Profile := Parameter_Specifications (Specification (N));
1189 else pragma Assert (K = N_Object_Declaration);
1190 Id := Defining_Identifier (N);
1192 if Nkind (Id) = N_Defining_Identifier
1193 and then Nkind (Parent (Etype (Id))) = N_Full_Type_Declaration
1194 and then Ekind (Etype (Id)) = E_Access_Subprogram_Type
1197 Parameter_Specifications (Type_Definition (Parent (Etype (Id))));
1203 -- Iterate through the parameter specification list, checking that
1204 -- no access parameter and no limited type parameter in the list.
1207 if Present (Profile) then
1208 Param_Spec := First (Profile);
1210 while Present (Param_Spec) loop
1211 Param_Type := Etype (Defining_Identifier (Param_Spec));
1212 Type_Decl := Parent (Param_Type);
1214 if Ekind (Param_Type) = E_Anonymous_Access_Type then
1216 if K = N_Subprogram_Declaration then
1217 Error_Node := Param_Spec;
1220 -- Report error only if declaration is in source program.
1222 if Comes_From_Source
1223 (Defining_Entity (Specification (N)))
1226 ("subprogram in rci unit cannot have access parameter",
1230 -- For limited private type parameter, we check only the
1231 -- private declaration and ignore full type declaration,
1232 -- unless this is the only declaration for the type, eg.
1233 -- as a limited record.
1235 elsif Is_Limited_Type (Param_Type)
1236 and then (Nkind (Type_Decl) = N_Private_Type_Declaration
1238 (Nkind (Type_Decl) = N_Full_Type_Declaration
1239 and then not (Has_Private_Declaration (Param_Type))
1240 and then Comes_From_Source (N)))
1242 -- A limited parameter is legal only if user-specified
1243 -- Read and Write attributes exist for it.
1244 -- second part of RM E.2.3 (14)
1246 if No (Full_View (Param_Type))
1247 and then Ekind (Param_Type) /= E_Record_Type
1249 -- Type does not have completion yet, so if declared in
1250 -- in the current RCI scope it is illegal, and will be
1251 -- flagged subsequently.
1255 Base_Param_Type := Base_Type (Underlying_Type (Param_Type));
1257 if No (TSS (Base_Param_Type, TSS_Stream_Read))
1259 No (TSS (Base_Param_Type, TSS_Stream_Write))
1261 if K = N_Subprogram_Declaration then
1262 Error_Node := Param_Spec;
1266 ("limited parameter in rci unit "
1267 & "must have read/write attributes ", Error_Node);
1268 Explain_Limited_Type (Param_Type, Error_Node);
1275 end Validate_RCI_Subprogram_Declaration;
1277 ----------------------------------------------------
1278 -- Validate_Remote_Access_Object_Type_Declaration --
1279 ----------------------------------------------------
1281 procedure Validate_Remote_Access_Object_Type_Declaration (T : Entity_Id) is
1282 Direct_Designated_Type : Entity_Id;
1283 Desig_Type : Entity_Id;
1284 Primitive_Subprograms : Elist_Id;
1285 Subprogram : Elmt_Id;
1286 Subprogram_Node : Node_Id;
1288 Param_Spec : Node_Id;
1289 Param_Type : Entity_Id;
1292 -- We are called from Analyze_Type_Declaration, and the Nkind
1293 -- of the given node is N_Access_To_Object_Definition.
1295 if not Comes_From_Source (T)
1296 or else (not In_RCI_Declaration (Parent (T))
1297 and then not In_RT_Declaration)
1302 -- An access definition in the private part of a Remote Types package
1303 -- may be legal if it has user-defined Read and Write attributes. This
1304 -- will be checked at the end of the package spec processing.
1306 if In_RT_Declaration and then In_Private_Part (Scope (T)) then
1310 -- Check RCI or RT unit type declaration. It may not contain
1311 -- the declaration of an access-to-object type unless it is a
1312 -- general access type that designates a class-wide limited
1313 -- private type. There are also constraints about the primitive
1314 -- subprograms of the class-wide type (RM E.2.3(14)).
1316 if Ekind (T) /= E_General_Access_Type
1317 or else Ekind (Designated_Type (T)) /= E_Class_Wide_Type
1319 if In_RCI_Declaration (Parent (T)) then
1321 ("access type in Remote_Call_Interface unit must be " &
1322 "general access", T);
1324 Error_Msg_N ("access type in Remote_Types unit must be " &
1325 "general access", T);
1327 Error_Msg_N ("\to class-wide type", T);
1331 Direct_Designated_Type := Designated_Type (T);
1332 Desig_Type := Etype (Direct_Designated_Type);
1334 if not Is_Recursively_Limited_Private (Desig_Type) then
1336 ("error in designated type of remote access to class-wide type", T);
1338 ("\must be tagged limited private or private extension of type", T);
1342 Primitive_Subprograms := Primitive_Operations (Desig_Type);
1343 Subprogram := First_Elmt (Primitive_Subprograms);
1345 while Subprogram /= No_Elmt loop
1346 Subprogram_Node := Node (Subprogram);
1348 if not Comes_From_Source (Subprogram_Node) then
1349 goto Next_Subprogram;
1352 Profile := Parameter_Specifications (Parent (Subprogram_Node));
1354 -- Profile must exist, otherwise not primitive operation
1356 Param_Spec := First (Profile);
1357 while Present (Param_Spec) loop
1359 -- Now find out if this parameter is a controlling parameter
1361 Param_Type := Parameter_Type (Param_Spec);
1363 if (Nkind (Param_Type) = N_Access_Definition
1364 and then Etype (Subtype_Mark (Param_Type)) = Desig_Type)
1365 or else (Nkind (Param_Type) /= N_Access_Definition
1366 and then Etype (Param_Type) = Desig_Type)
1368 -- It is a controlling parameter, so specific checks below
1374 Nkind (Param_Type) = N_Access_Definition
1376 -- From RM E.2.2(14), no access parameter other than
1377 -- controlling ones may be used.
1380 ("non-controlling access parameter", Param_Spec);
1383 Is_Limited_Type (Etype (Defining_Identifier (Param_Spec)))
1385 -- Not a controlling parameter, so type must have Read
1386 -- and Write attributes.
1388 if Nkind (Param_Type) in N_Has_Etype
1389 and then Nkind (Parent (Etype (Param_Type))) =
1390 N_Private_Type_Declaration
1392 Param_Type := Etype (Param_Type);
1394 if No (TSS (Param_Type, TSS_Stream_Read))
1396 No (TSS (Param_Type, TSS_Stream_Write))
1399 ("limited formal must have Read and Write attributes",
1401 Explain_Limited_Type
1402 (Etype (Defining_Identifier (Param_Spec)), Param_Spec);
1407 -- Check next parameter in this subprogram
1413 Next_Elmt (Subprogram);
1416 -- Now this is an RCI unit access-to-class-wide-limited-private type
1417 -- declaration. Set the type entity to be Is_Remote_Call_Interface to
1418 -- optimize later checks by avoiding tree traversal to find out if this
1419 -- entity is inside an RCI unit.
1421 Set_Is_Remote_Call_Interface (T);
1422 end Validate_Remote_Access_Object_Type_Declaration;
1424 -----------------------------------------------
1425 -- Validate_Remote_Access_To_Class_Wide_Type --
1426 -----------------------------------------------
1428 procedure Validate_Remote_Access_To_Class_Wide_Type (N : Node_Id) is
1429 K : constant Node_Kind := Nkind (N);
1430 PK : constant Node_Kind := Nkind (Parent (N));
1434 -- This subprogram enforces the checks in (RM E.2.2(8)) for certain uses
1435 -- of class-wide limited private types.
1437 -- Storage_Pool and Storage_Size are not defined for such types
1439 -- The expected type of allocator must not not be such a type.
1441 -- The actual parameter of generic instantiation must not be such a
1442 -- type if the formal parameter is of an access type.
1444 -- On entry, there are five cases
1446 -- 1. called from sem_attr Analyze_Attribute where attribute name is
1447 -- either Storage_Pool or Storage_Size.
1449 -- 2. called from exp_ch4 Expand_N_Allocator
1451 -- 3. called from sem_ch12 Analyze_Associations
1453 -- 4. called from sem_ch4 Analyze_Explicit_Dereference
1455 -- 5. called from sem_res Resolve_Actuals
1457 if K = N_Attribute_Reference then
1458 E := Etype (Prefix (N));
1460 if Is_Remote_Access_To_Class_Wide_Type (E) then
1461 Error_Msg_N ("incorrect attribute of remote operand", N);
1465 elsif K = N_Allocator then
1468 if Is_Remote_Access_To_Class_Wide_Type (E) then
1469 Error_Msg_N ("incorrect expected remote type of allocator", N);
1473 elsif K in N_Has_Entity then
1476 if Is_Remote_Access_To_Class_Wide_Type (E) then
1477 Error_Msg_N ("incorrect remote type generic actual", N);
1481 -- This subprogram also enforces the checks in E.2.2(13). A value of
1482 -- such type must not be dereferenced unless as controlling operand of a
1483 -- dispatching call.
1485 elsif K = N_Explicit_Dereference
1486 and then (Comes_From_Source (N)
1487 or else (Nkind (Original_Node (N)) = N_Selected_Component
1488 and then Comes_From_Source (Original_Node (N))))
1490 E := Etype (Prefix (N));
1492 -- If the class-wide type is not a remote one, the restrictions
1495 if not Is_Remote_Access_To_Class_Wide_Type (E) then
1499 -- If we have a true dereference that comes from source and that
1500 -- is a controlling argument for a dispatching call, accept it.
1502 if K = N_Explicit_Dereference
1503 and then Is_Actual_Parameter (N)
1504 and then Is_Controlling_Actual (N)
1509 -- If we are just within a procedure or function call and the
1510 -- dereference has not been analyzed, return because this procedure
1511 -- will be called again from sem_res Resolve_Actuals.
1513 if Is_Actual_Parameter (N)
1514 and then not Analyzed (N)
1519 -- The following is to let the compiler generated tags check pass
1520 -- through without error message. This is a bit kludgy isn't there
1521 -- some better way of making this exclusion ???
1523 if (PK = N_Selected_Component
1524 and then Present (Parent (Parent (N)))
1525 and then Nkind (Parent (Parent (N))) = N_Op_Ne)
1526 or else (PK = N_Unchecked_Type_Conversion
1527 and then Present (Parent (Parent (N)))
1529 Nkind (Parent (Parent (N))) = N_Selected_Component)
1534 -- The following code is needed for expansion of RACW Write
1535 -- attribute, since such expressions can appear in the expanded
1538 if not Comes_From_Source (N)
1541 or else PK = N_Attribute_Reference
1543 (PK = N_Type_Conversion
1544 and then Present (Parent (N))
1545 and then Present (Parent (Parent (N)))
1547 Nkind (Parent (Parent (N))) = N_Selected_Component))
1552 Error_Msg_N ("incorrect remote type dereference", N);
1554 end Validate_Remote_Access_To_Class_Wide_Type;
1556 ------------------------------------------
1557 -- Validate_Remote_Type_Type_Conversion --
1558 ------------------------------------------
1560 procedure Validate_Remote_Type_Type_Conversion (N : Node_Id) is
1561 S : constant Entity_Id := Etype (N);
1562 E : constant Entity_Id := Etype (Expression (N));
1565 -- This test is required in the case where a conversion appears inside a
1566 -- normal package, it does not necessarily have to be inside an RCI,
1567 -- Remote_Types unit (RM E.2.2(9,12)).
1569 if Is_Remote_Access_To_Subprogram_Type (E)
1570 and then not Is_Remote_Access_To_Subprogram_Type (S)
1573 ("incorrect conversion of remote operand to local type", N);
1576 elsif not Is_Remote_Access_To_Subprogram_Type (E)
1577 and then Is_Remote_Access_To_Subprogram_Type (S)
1580 ("incorrect conversion of local operand to remote type", N);
1583 elsif Is_Remote_Access_To_Class_Wide_Type (E)
1584 and then not Is_Remote_Access_To_Class_Wide_Type (S)
1587 ("incorrect conversion of remote operand to local type", N);
1591 -- If a local access type is converted into a RACW type, then the
1592 -- current unit has a pointer that may now be exported to another
1595 if Is_Remote_Access_To_Class_Wide_Type (S)
1596 and then not Is_Remote_Access_To_Class_Wide_Type (E)
1598 Set_Has_RACW (Current_Sem_Unit);
1600 end Validate_Remote_Type_Type_Conversion;
1602 -------------------------------
1603 -- Validate_RT_RAT_Component --
1604 -------------------------------
1606 procedure Validate_RT_RAT_Component (N : Node_Id) is
1607 Spec : constant Node_Id := Specification (N);
1608 Name_U : constant Entity_Id := Defining_Entity (Spec);
1610 First_Priv_Ent : constant Entity_Id := First_Private_Entity (Name_U);
1611 In_Visible_Part : Boolean := True;
1614 if not Is_Remote_Types (Name_U) then
1618 Typ := First_Entity (Name_U);
1619 while Present (Typ) loop
1620 if In_Visible_Part and then Typ = First_Priv_Ent then
1621 In_Visible_Part := False;
1624 if Comes_From_Source (Typ)
1625 and then Is_Type (Typ)
1626 and then (In_Visible_Part or else Has_Private_Declaration (Typ))
1628 if Missing_Read_Write_Attributes (Typ) then
1629 if Is_Non_Remote_Access_Type (Typ) then
1631 ("non-remote access type without user-defined Read " &
1632 "and Write attributes", Typ);
1635 ("record type containing a component of a " &
1636 "non-remote access", Typ);
1638 ("\type without Read and Write attributes " &
1639 "('R'M E.2.2(8))", Typ);
1646 end Validate_RT_RAT_Component;
1648 -----------------------------------------
1649 -- Validate_SP_Access_Object_Type_Decl --
1650 -----------------------------------------
1652 procedure Validate_SP_Access_Object_Type_Decl (T : Entity_Id) is
1653 Direct_Designated_Type : Entity_Id;
1655 function Has_Entry_Declarations (E : Entity_Id) return Boolean;
1656 -- Return true if the protected type designated by T has
1657 -- entry declarations.
1659 ----------------------------
1660 -- Has_Entry_Declarations --
1661 ----------------------------
1663 function Has_Entry_Declarations (E : Entity_Id) return Boolean is
1667 if Nkind (Parent (E)) = N_Protected_Type_Declaration then
1668 Ety := First_Entity (E);
1669 while Present (Ety) loop
1670 if Ekind (Ety) = E_Entry then
1679 end Has_Entry_Declarations;
1681 -- Start of processing for Validate_SP_Access_Object_Type_Decl
1684 -- We are called from Sem_Ch3.Analyze_Type_Declaration, and the
1685 -- Nkind of the given entity is N_Access_To_Object_Definition.
1687 if not Comes_From_Source (T)
1688 or else not In_Shared_Passive_Unit
1689 or else In_Subprogram_Task_Protected_Unit
1694 -- Check Shared Passive unit. It should not contain the declaration
1695 -- of an access-to-object type whose designated type is a class-wide
1696 -- type, task type or protected type with entry (RM E.2.1(7)).
1698 Direct_Designated_Type := Designated_Type (T);
1700 if Ekind (Direct_Designated_Type) = E_Class_Wide_Type then
1702 ("invalid access-to-class-wide type in shared passive unit", T);
1705 elsif Ekind (Direct_Designated_Type) in Task_Kind then
1707 ("invalid access-to-task type in shared passive unit", T);
1710 elsif Ekind (Direct_Designated_Type) in Protected_Kind
1711 and then Has_Entry_Declarations (Direct_Designated_Type)
1714 ("invalid access-to-protected type in shared passive unit", T);
1717 end Validate_SP_Access_Object_Type_Decl;
1719 ---------------------------------
1720 -- Validate_Static_Object_Name --
1721 ---------------------------------
1723 procedure Validate_Static_Object_Name (N : Node_Id) is
1726 function Is_Primary (N : Node_Id) return Boolean;
1727 -- Determine whether node is syntactically a primary in an expression.
1733 function Is_Primary (N : Node_Id) return Boolean is
1734 K : constant Node_Kind := Nkind (Parent (N));
1738 when N_Op | N_In | N_Not_In =>
1742 | N_Component_Association
1743 | N_Index_Or_Discriminant_Constraint =>
1746 when N_Attribute_Reference =>
1747 return Attribute_Name (Parent (N)) /= Name_Address
1748 and then Attribute_Name (Parent (N)) /= Name_Access
1749 and then Attribute_Name (Parent (N)) /= Name_Unchecked_Access
1751 Attribute_Name (Parent (N)) /= Name_Unrestricted_Access;
1753 when N_Indexed_Component =>
1754 return (N /= Prefix (Parent (N))
1755 or else Is_Primary (Parent (N)));
1757 when N_Qualified_Expression | N_Type_Conversion =>
1758 return Is_Primary (Parent (N));
1760 when N_Assignment_Statement | N_Object_Declaration =>
1761 return (N = Expression (Parent (N)));
1763 when N_Selected_Component =>
1764 return Is_Primary (Parent (N));
1771 -- Start of processing for Validate_Static_Object_Name
1774 if not In_Preelaborated_Unit
1775 or else not Comes_From_Source (N)
1776 or else In_Subprogram_Or_Concurrent_Unit
1777 or else Ekind (Current_Scope) = E_Block
1781 -- Filter out cases where primary is default in a component declaration,
1782 -- discriminant specification, or actual in a record type initialization
1785 -- Initialization call of internal types.
1787 elsif Nkind (Parent (N)) = N_Procedure_Call_Statement then
1789 if Present (Parent (Parent (N)))
1790 and then Nkind (Parent (Parent (N))) = N_Freeze_Entity
1795 if Nkind (Name (Parent (N))) = N_Identifier
1796 and then not Comes_From_Source (Entity (Name (Parent (N))))
1802 -- Error if the name is a primary in an expression. The parent must not
1803 -- be an operator, or a selected component or an indexed component that
1804 -- is itself a primary. Entities that are actuals do not need to be
1805 -- checked, because the call itself will be diagnosed.
1808 and then (not Inside_A_Generic
1809 or else Present (Enclosing_Generic_Body (N)))
1811 if Ekind (Entity (N)) = E_Variable then
1812 Flag_Non_Static_Expr
1813 ("non-static object name in preelaborated unit", N);
1815 -- We take the view that a constant defined in another preelaborated
1816 -- unit is preelaborable, even though it may have a private type and
1817 -- thus appear non-static in a client. This must be the intent of
1818 -- the language, but currently is an RM gap ???
1820 elsif Ekind (Entity (N)) = E_Constant
1821 and then not Is_Static_Expression (N)
1825 if Is_Internal_File_Name (Unit_File_Name (Get_Source_Unit (N)))
1827 Enclosing_Lib_Unit_Node (N) /= Enclosing_Lib_Unit_Node (E)
1828 and then (Is_Preelaborated (Scope (E))
1829 or else Is_Pure (Scope (E))
1830 or else (Present (Renamed_Object (E))
1832 Is_Entity_Name (Renamed_Object (E))
1835 (Scope (Renamed_Object (E)))
1838 (Renamed_Object (E))))))
1842 -- This is the error case
1845 -- In GNAT mode, this is just a warning, to allow it to be
1846 -- judiciously turned off. Otherwise it is a real error.
1850 ("?non-static constant in preelaborated unit", N);
1852 Flag_Non_Static_Expr
1853 ("non-static constant in preelaborated unit", N);
1859 end Validate_Static_Object_Name;