1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- S E M _ S M E M -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1998-2008, Free Software Foundation, Inc. -- 10-- -- 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 3, 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 COPYING3. If not, go to -- 19-- http://www.gnu.org/licenses for a complete copy of the license. -- 20-- -- 21-- GNAT was originally developed by the GNAT team at New York University. -- 22-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23-- -- 24------------------------------------------------------------------------------ 25 26with Atree; use Atree; 27with Einfo; use Einfo; 28with Errout; use Errout; 29with Namet; use Namet; 30with Sem_Aux; use Sem_Aux; 31with Sinfo; use Sinfo; 32with Snames; use Snames; 33 34package body Sem_Smem is 35 36 function Contains_Access_Type (T : Entity_Id) return Boolean; 37 -- This function determines if type T is an access type, or contains 38 -- a component (array, record, protected type cases) that contains 39 -- an access type (recursively defined in the appropriate manner). 40 41 ---------------------- 42 -- Check_Shared_Var -- 43 ---------------------- 44 45 procedure Check_Shared_Var 46 (Id : Entity_Id; 47 T : Entity_Id; 48 N : Node_Id) 49 is 50 begin 51 -- We cannot tolerate aliased variables, because they might be 52 -- modified via an aliased pointer, and we could not detect that 53 -- this was happening (to update the corresponding shared memory 54 -- file), so we must disallow all use of Aliased 55 56 if Aliased_Present (N) then 57 Error_Msg_N 58 ("aliased variables " & 59 "not supported in Shared_Passive partitions", 60 N); 61 62 -- We can't support access types at all, since they are local 63 -- pointers that cannot in any simple way be transmitted to other 64 -- partitions. 65 66 elsif Is_Access_Type (T) then 67 Error_Msg_N 68 ("access type variables " & 69 "not supported in Shared_Passive partitions", 70 Id); 71 72 -- We cannot tolerate types that contain access types, same reasons 73 74 elsif Contains_Access_Type (T) then 75 Error_Msg_N 76 ("types containing access components " & 77 "not supported in Shared_Passive partitions", 78 Id); 79 80 -- Objects with default-initialized types will be rejected when 81 -- the initialization code is generated. However we must flag tasks 82 -- earlier on, to prevent expansion of stream attributes that is 83 -- bound to fail. 84 85 elsif Has_Task (T) then 86 Error_Msg_N 87 ("Shared_Passive partitions cannot contain tasks", Id); 88 89 -- Currently we do not support unconstrained record types, since we 90 -- use 'Write to write out values. This could probably be special 91 -- cased and handled in the future if necessary. 92 93 elsif Is_Record_Type (T) 94 and then not Is_Constrained (T) 95 then 96 Error_Msg_N 97 ("unconstrained variant records " & 98 "not supported in Shared_Passive partitions", 99 Id); 100 end if; 101 end Check_Shared_Var; 102 103 -------------------------- 104 -- Contains_Access_Type -- 105 -------------------------- 106 107 function Contains_Access_Type (T : Entity_Id) return Boolean is 108 C : Entity_Id; 109 110 begin 111 if Is_Access_Type (T) then 112 return True; 113 114 elsif Is_Array_Type (T) then 115 return Contains_Access_Type (Component_Type (T)); 116 117 elsif Is_Record_Type (T) then 118 if Has_Discriminants (T) then 119 C := First_Discriminant (T); 120 while Present (C) loop 121 if Comes_From_Source (C) then 122 return True; 123 else 124 C := Next_Discriminant (C); 125 end if; 126 end loop; 127 end if; 128 129 C := First_Component (T); 130 while Present (C) loop 131 132 -- For components, ignore internal components other than _Parent 133 134 if Comes_From_Source (T) 135 and then 136 (Chars (C) = Name_uParent 137 or else 138 not Is_Internal_Name (Chars (C))) 139 and then Contains_Access_Type (Etype (C)) 140 then 141 return True; 142 else 143 C := Next_Component (C); 144 end if; 145 end loop; 146 147 return False; 148 149 elsif Is_Protected_Type (T) then 150 return Contains_Access_Type (Corresponding_Record_Type (T)); 151 152 else 153 return False; 154 end if; 155 end Contains_Access_Type; 156 157end Sem_Smem; 158