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