]>
Commit | Line | Data |
---|---|---|
415dddc8 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- U N A M E -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
fbf5a39b | 9 | -- Copyright (C) 1992-2002, Free Software Foundation, Inc. -- |
415dddc8 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- -- | |
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, 59 Temple Place - Suite 330, Boston, -- | |
20 | -- MA 02111-1307, USA. -- | |
21 | -- -- | |
22 | -- As a special exception, if other files instantiate generics from this -- | |
23 | -- unit, or you link this unit with other files to produce an executable, -- | |
24 | -- this unit does not by itself cause the resulting executable to be -- | |
25 | -- covered by the GNU General Public License. This exception does not -- | |
26 | -- however invalidate any other reasons why the executable file might be -- | |
27 | -- covered by the GNU Public License. -- | |
28 | -- -- | |
29 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 30 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
415dddc8 RK |
31 | -- -- |
32 | ------------------------------------------------------------------------------ | |
33 | ||
34 | with Atree; use Atree; | |
35 | with Casing; use Casing; | |
36 | with Einfo; use Einfo; | |
37 | with Hostparm; | |
38 | with Lib; use Lib; | |
39 | with Namet; use Namet; | |
40 | with Nlists; use Nlists; | |
41 | with Output; use Output; | |
42 | with Sinfo; use Sinfo; | |
43 | with Sinput; use Sinput; | |
44 | ||
45 | package body Uname is | |
46 | ||
47 | ------------------- | |
48 | -- Get_Body_Name -- | |
49 | ------------------- | |
50 | ||
51 | function Get_Body_Name (N : Unit_Name_Type) return Unit_Name_Type is | |
52 | begin | |
53 | Get_Name_String (N); | |
54 | ||
55 | pragma Assert (Name_Len > 2 | |
56 | and then Name_Buffer (Name_Len - 1) = '%' | |
57 | and then Name_Buffer (Name_Len) = 's'); | |
58 | ||
59 | Name_Buffer (Name_Len) := 'b'; | |
60 | return Name_Find; | |
61 | end Get_Body_Name; | |
62 | ||
63 | ----------------------------------- | |
64 | -- Get_External_Unit_Name_String -- | |
65 | ----------------------------------- | |
66 | ||
67 | procedure Get_External_Unit_Name_String (N : Unit_Name_Type) is | |
68 | Pcount : Natural; | |
69 | Newlen : Natural; | |
70 | ||
71 | begin | |
72 | -- Get unit name and eliminate trailing %s or %b | |
73 | ||
74 | Get_Name_String (N); | |
75 | Name_Len := Name_Len - 2; | |
76 | ||
77 | -- Find number of components | |
78 | ||
79 | Pcount := 0; | |
80 | for J in 1 .. Name_Len loop | |
81 | if Name_Buffer (J) = '.' then | |
82 | Pcount := Pcount + 1; | |
83 | end if; | |
84 | end loop; | |
85 | ||
86 | -- If simple name, nothing to do | |
87 | ||
88 | if Pcount = 0 then | |
89 | return; | |
90 | end if; | |
91 | ||
92 | -- If name has multiple components, replace dots by double underscore | |
93 | ||
94 | Newlen := Name_Len + Pcount; | |
95 | ||
96 | for J in reverse 1 .. Name_Len loop | |
97 | if Name_Buffer (J) = '.' then | |
98 | Name_Buffer (Newlen) := '_'; | |
99 | Name_Buffer (Newlen - 1) := '_'; | |
100 | Newlen := Newlen - 2; | |
101 | ||
102 | else | |
103 | Name_Buffer (Newlen) := Name_Buffer (J); | |
104 | Newlen := Newlen - 1; | |
105 | end if; | |
106 | end loop; | |
107 | ||
108 | Name_Len := Name_Len + Pcount; | |
109 | end Get_External_Unit_Name_String; | |
110 | ||
111 | -------------------------- | |
112 | -- Get_Parent_Body_Name -- | |
113 | -------------------------- | |
114 | ||
115 | function Get_Parent_Body_Name (N : Unit_Name_Type) return Unit_Name_Type is | |
116 | begin | |
117 | Get_Name_String (N); | |
118 | ||
119 | while Name_Buffer (Name_Len) /= '.' loop | |
120 | pragma Assert (Name_Len > 1); -- not a child or subunit name | |
121 | Name_Len := Name_Len - 1; | |
122 | end loop; | |
123 | ||
124 | Name_Buffer (Name_Len) := '%'; | |
125 | Name_Len := Name_Len + 1; | |
126 | Name_Buffer (Name_Len) := 'b'; | |
127 | return Name_Find; | |
128 | ||
129 | end Get_Parent_Body_Name; | |
130 | ||
131 | -------------------------- | |
132 | -- Get_Parent_Spec_Name -- | |
133 | -------------------------- | |
134 | ||
135 | function Get_Parent_Spec_Name (N : Unit_Name_Type) return Unit_Name_Type is | |
136 | begin | |
137 | Get_Name_String (N); | |
138 | ||
139 | while Name_Buffer (Name_Len) /= '.' loop | |
140 | if Name_Len = 1 then | |
141 | return No_Name; -- not a child or subunit name | |
142 | else | |
143 | Name_Len := Name_Len - 1; | |
144 | end if; | |
145 | end loop; | |
146 | ||
147 | Name_Buffer (Name_Len) := '%'; | |
148 | Name_Len := Name_Len + 1; | |
149 | Name_Buffer (Name_Len) := 's'; | |
150 | return Name_Find; | |
151 | ||
152 | end Get_Parent_Spec_Name; | |
153 | ||
154 | ------------------- | |
155 | -- Get_Spec_Name -- | |
156 | ------------------- | |
157 | ||
158 | function Get_Spec_Name (N : Unit_Name_Type) return Unit_Name_Type is | |
159 | begin | |
160 | Get_Name_String (N); | |
161 | ||
162 | pragma Assert (Name_Len > 2 | |
163 | and then Name_Buffer (Name_Len - 1) = '%' | |
164 | and then Name_Buffer (Name_Len) = 'b'); | |
165 | ||
166 | Name_Buffer (Name_Len) := 's'; | |
167 | return Name_Find; | |
168 | end Get_Spec_Name; | |
169 | ||
170 | ------------------- | |
171 | -- Get_Unit_Name -- | |
172 | ------------------- | |
173 | ||
174 | function Get_Unit_Name (N : Node_Id) return Unit_Name_Type is | |
175 | ||
176 | Unit_Name_Buffer : String (1 .. Hostparm.Max_Name_Length); | |
177 | -- Buffer used to build name of unit. Note that we cannot use the | |
178 | -- Name_Buffer in package Name_Table because we use it to read | |
179 | -- component names. | |
180 | ||
181 | Unit_Name_Length : Natural := 0; | |
182 | -- Length of name stored in Unit_Name_Buffer | |
183 | ||
184 | Node : Node_Id; | |
185 | -- Program unit node | |
186 | ||
187 | procedure Add_Char (C : Character); | |
188 | -- Add a single character to stored unit name | |
189 | ||
190 | procedure Add_Name (Name : Name_Id); | |
191 | -- Add the characters of a names table entry to stored unit name | |
192 | ||
193 | procedure Add_Node_Name (Node : Node_Id); | |
194 | -- Recursive procedure adds characters associated with Node | |
195 | ||
196 | function Get_Parent (Node : Node_Id) return Node_Id; | |
197 | -- Get parent compilation unit of a stub | |
198 | ||
199 | -------------- | |
200 | -- Add_Char -- | |
201 | -------------- | |
202 | ||
203 | procedure Add_Char (C : Character) is | |
204 | begin | |
205 | -- Should really check for max length exceeded here??? | |
206 | Unit_Name_Length := Unit_Name_Length + 1; | |
207 | Unit_Name_Buffer (Unit_Name_Length) := C; | |
208 | end Add_Char; | |
209 | ||
210 | -------------- | |
211 | -- Add_Name -- | |
212 | -------------- | |
213 | ||
214 | procedure Add_Name (Name : Name_Id) is | |
215 | begin | |
216 | Get_Name_String (Name); | |
217 | ||
218 | for J in 1 .. Name_Len loop | |
219 | Add_Char (Name_Buffer (J)); | |
220 | end loop; | |
221 | end Add_Name; | |
222 | ||
223 | ------------------- | |
224 | -- Add_Node_Name -- | |
225 | ------------------- | |
226 | ||
227 | procedure Add_Node_Name (Node : Node_Id) is | |
fbf5a39b | 228 | Kind : constant Node_Kind := Nkind (Node); |
415dddc8 RK |
229 | |
230 | begin | |
231 | -- Just ignore an error node (someone else will give a message) | |
232 | ||
233 | if Node = Error then | |
234 | return; | |
235 | ||
236 | -- Otherwise see what kind of node we have | |
237 | ||
238 | else | |
239 | case Kind is | |
240 | ||
241 | when N_Identifier | | |
242 | N_Defining_Identifier | | |
243 | N_Defining_Operator_Symbol => | |
244 | ||
245 | -- Note: it is of course an error to have a defining | |
246 | -- operator symbol at this point, but this is not where | |
247 | -- the error is signalled, so we handle it nicely here! | |
248 | ||
249 | Add_Name (Chars (Node)); | |
250 | ||
251 | when N_Defining_Program_Unit_Name => | |
252 | Add_Node_Name (Name (Node)); | |
253 | Add_Char ('.'); | |
254 | Add_Node_Name (Defining_Identifier (Node)); | |
255 | ||
256 | when N_Selected_Component | | |
257 | N_Expanded_Name => | |
258 | Add_Node_Name (Prefix (Node)); | |
259 | Add_Char ('.'); | |
260 | Add_Node_Name (Selector_Name (Node)); | |
261 | ||
262 | when N_Subprogram_Specification | | |
263 | N_Package_Specification => | |
264 | Add_Node_Name (Defining_Unit_Name (Node)); | |
265 | ||
266 | when N_Subprogram_Body | | |
267 | N_Subprogram_Declaration | | |
268 | N_Package_Declaration | | |
269 | N_Generic_Declaration => | |
270 | Add_Node_Name (Specification (Node)); | |
271 | ||
272 | when N_Generic_Instantiation => | |
273 | Add_Node_Name (Defining_Unit_Name (Node)); | |
274 | ||
275 | when N_Package_Body => | |
276 | Add_Node_Name (Defining_Unit_Name (Node)); | |
277 | ||
278 | when N_Task_Body | | |
279 | N_Protected_Body => | |
280 | Add_Node_Name (Defining_Identifier (Node)); | |
281 | ||
282 | when N_Package_Renaming_Declaration => | |
283 | Add_Node_Name (Defining_Unit_Name (Node)); | |
284 | ||
285 | when N_Subprogram_Renaming_Declaration => | |
286 | Add_Node_Name (Specification (Node)); | |
287 | ||
288 | when N_Generic_Renaming_Declaration => | |
289 | Add_Node_Name (Defining_Unit_Name (Node)); | |
290 | ||
291 | when N_Subprogram_Body_Stub => | |
292 | Add_Node_Name (Get_Parent (Node)); | |
293 | Add_Char ('.'); | |
294 | Add_Node_Name (Specification (Node)); | |
295 | ||
296 | when N_Compilation_Unit => | |
297 | Add_Node_Name (Unit (Node)); | |
298 | ||
299 | when N_Package_Body_Stub => | |
300 | Add_Node_Name (Get_Parent (Node)); | |
301 | Add_Char ('.'); | |
302 | Add_Node_Name (Defining_Identifier (Node)); | |
303 | ||
304 | when N_Task_Body_Stub | | |
305 | N_Protected_Body_Stub => | |
306 | Add_Node_Name (Get_Parent (Node)); | |
307 | Add_Char ('.'); | |
308 | Add_Node_Name (Defining_Identifier (Node)); | |
309 | ||
310 | when N_Subunit => | |
311 | Add_Node_Name (Name (Node)); | |
312 | Add_Char ('.'); | |
313 | Add_Node_Name (Proper_Body (Node)); | |
314 | ||
315 | when N_With_Clause => | |
316 | Add_Node_Name (Name (Node)); | |
317 | ||
318 | when N_Pragma => | |
319 | Add_Node_Name (Expression (First | |
320 | (Pragma_Argument_Associations (Node)))); | |
321 | ||
322 | -- Tasks and protected stuff appear only in an error context, | |
323 | -- but the error has been posted elsewhere, so we deal nicely | |
324 | -- with these error situations here, and produce a reasonable | |
325 | -- unit name using the defining identifier. | |
326 | ||
327 | when N_Task_Type_Declaration | | |
328 | N_Single_Task_Declaration | | |
329 | N_Protected_Type_Declaration | | |
330 | N_Single_Protected_Declaration => | |
331 | Add_Node_Name (Defining_Identifier (Node)); | |
332 | ||
333 | when others => | |
334 | raise Program_Error; | |
335 | ||
336 | end case; | |
337 | end if; | |
338 | end Add_Node_Name; | |
339 | ||
340 | ---------------- | |
341 | -- Get_Parent -- | |
342 | ---------------- | |
343 | ||
344 | function Get_Parent (Node : Node_Id) return Node_Id is | |
345 | N : Node_Id := Node; | |
346 | ||
347 | begin | |
348 | while Nkind (N) /= N_Compilation_Unit loop | |
349 | N := Parent (N); | |
350 | end loop; | |
351 | ||
352 | return N; | |
353 | end Get_Parent; | |
354 | ||
355 | -------------------------------------------- | |
356 | -- Start of Processing for Get_Unit_Name -- | |
357 | -------------------------------------------- | |
358 | ||
359 | begin | |
360 | Node := N; | |
361 | ||
362 | -- If we have Defining_Identifier, find the associated unit node | |
363 | ||
364 | if Nkind (Node) = N_Defining_Identifier then | |
365 | Node := Declaration_Node (Node); | |
366 | ||
367 | -- If an expanded name, it is an already analyzed child unit, find | |
368 | -- unit node. | |
369 | ||
370 | elsif Nkind (Node) = N_Expanded_Name then | |
371 | Node := Declaration_Node (Entity (Node)); | |
372 | end if; | |
373 | ||
374 | if Nkind (Node) = N_Package_Specification | |
375 | or else Nkind (Node) in N_Subprogram_Specification | |
376 | then | |
377 | Node := Parent (Node); | |
378 | end if; | |
379 | ||
380 | -- Node points to the unit, so get its name and add proper suffix | |
381 | ||
382 | Add_Node_Name (Node); | |
383 | Add_Char ('%'); | |
384 | ||
385 | case Nkind (Node) is | |
386 | when N_Generic_Declaration | | |
387 | N_Subprogram_Declaration | | |
388 | N_Package_Declaration | | |
389 | N_With_Clause | | |
390 | N_Pragma | | |
391 | N_Generic_Instantiation | | |
392 | N_Package_Renaming_Declaration | | |
393 | N_Subprogram_Renaming_Declaration | | |
394 | N_Generic_Renaming_Declaration | | |
395 | N_Single_Task_Declaration | | |
396 | N_Single_Protected_Declaration | | |
397 | N_Task_Type_Declaration | | |
398 | N_Protected_Type_Declaration => | |
399 | ||
400 | Add_Char ('s'); | |
401 | ||
402 | when N_Subprogram_Body | | |
403 | N_Package_Body | | |
404 | N_Subunit | | |
405 | N_Body_Stub | | |
406 | N_Task_Body | | |
407 | N_Protected_Body | | |
408 | N_Identifier | | |
409 | N_Selected_Component => | |
410 | ||
411 | Add_Char ('b'); | |
412 | ||
413 | when others => | |
414 | raise Program_Error; | |
415 | end case; | |
416 | ||
417 | Name_Buffer (1 .. Unit_Name_Length) := | |
418 | Unit_Name_Buffer (1 .. Unit_Name_Length); | |
419 | Name_Len := Unit_Name_Length; | |
420 | return Name_Find; | |
421 | ||
422 | end Get_Unit_Name; | |
423 | ||
424 | -------------------------- | |
425 | -- Get_Unit_Name_String -- | |
426 | -------------------------- | |
427 | ||
428 | procedure Get_Unit_Name_String (N : Unit_Name_Type) is | |
429 | Unit_Is_Body : Boolean; | |
430 | ||
431 | begin | |
432 | Get_Decoded_Name_String (N); | |
433 | Unit_Is_Body := Name_Buffer (Name_Len) = 'b'; | |
434 | Set_Casing (Identifier_Casing (Source_Index (Main_Unit)), Mixed_Case); | |
435 | ||
436 | -- A special fudge, normally we don't have operator symbols present, | |
437 | -- since it is always an error to do so. However, if we do, at this | |
438 | -- stage it has the form: | |
439 | ||
440 | -- "and" | |
441 | ||
442 | -- and the %s or %b has already been eliminated so put 2 chars back | |
443 | ||
444 | if Name_Buffer (1) = '"' then | |
445 | Name_Len := Name_Len + 2; | |
446 | end if; | |
447 | ||
448 | -- Now adjust the %s or %b to (spec) or (body) | |
449 | ||
450 | if Unit_Is_Body then | |
451 | Name_Buffer (Name_Len - 1 .. Name_Len + 5) := " (body)"; | |
452 | else | |
453 | Name_Buffer (Name_Len - 1 .. Name_Len + 5) := " (spec)"; | |
454 | end if; | |
455 | ||
456 | for J in 1 .. Name_Len loop | |
457 | if Name_Buffer (J) = '-' then | |
458 | Name_Buffer (J) := '.'; | |
459 | end if; | |
460 | end loop; | |
461 | ||
462 | Name_Len := Name_Len + (7 - 2); | |
463 | end Get_Unit_Name_String; | |
464 | ||
465 | ------------------ | |
466 | -- Is_Body_Name -- | |
467 | ------------------ | |
468 | ||
469 | function Is_Body_Name (N : Unit_Name_Type) return Boolean is | |
470 | begin | |
471 | Get_Name_String (N); | |
472 | return Name_Len > 2 | |
473 | and then Name_Buffer (Name_Len - 1) = '%' | |
474 | and then Name_Buffer (Name_Len) = 'b'; | |
475 | end Is_Body_Name; | |
476 | ||
477 | ------------------- | |
478 | -- Is_Child_Name -- | |
479 | ------------------- | |
480 | ||
481 | function Is_Child_Name (N : Unit_Name_Type) return Boolean is | |
482 | J : Natural; | |
483 | ||
484 | begin | |
485 | Get_Name_String (N); | |
486 | J := Name_Len; | |
487 | ||
488 | while Name_Buffer (J) /= '.' loop | |
489 | if J = 1 then | |
490 | return False; -- not a child or subunit name | |
491 | else | |
492 | J := J - 1; | |
493 | end if; | |
494 | end loop; | |
495 | ||
496 | return True; | |
497 | end Is_Child_Name; | |
498 | ||
499 | ------------------ | |
500 | -- Is_Spec_Name -- | |
501 | ------------------ | |
502 | ||
503 | function Is_Spec_Name (N : Unit_Name_Type) return Boolean is | |
504 | begin | |
505 | Get_Name_String (N); | |
506 | return Name_Len > 2 | |
507 | and then Name_Buffer (Name_Len - 1) = '%' | |
508 | and then Name_Buffer (Name_Len) = 's'; | |
509 | end Is_Spec_Name; | |
510 | ||
511 | ----------------------- | |
512 | -- Name_To_Unit_Name -- | |
513 | ----------------------- | |
514 | ||
515 | function Name_To_Unit_Name (N : Name_Id) return Unit_Name_Type is | |
516 | begin | |
517 | Get_Name_String (N); | |
518 | Name_Buffer (Name_Len + 1) := '%'; | |
519 | Name_Buffer (Name_Len + 2) := 's'; | |
520 | Name_Len := Name_Len + 2; | |
521 | return Name_Find; | |
522 | end Name_To_Unit_Name; | |
523 | ||
524 | --------------- | |
525 | -- New_Child -- | |
526 | --------------- | |
527 | ||
528 | function New_Child | |
529 | (Old : Unit_Name_Type; | |
530 | Newp : Unit_Name_Type) | |
531 | return Unit_Name_Type | |
532 | is | |
533 | P : Natural; | |
534 | ||
535 | begin | |
536 | Get_Name_String (Old); | |
537 | ||
538 | declare | |
fbf5a39b | 539 | Child : constant String := Name_Buffer (1 .. Name_Len); |
415dddc8 RK |
540 | |
541 | begin | |
542 | Get_Name_String (Newp); | |
543 | Name_Len := Name_Len - 2; | |
544 | ||
545 | P := Child'Last; | |
546 | while Child (P) /= '.' loop | |
547 | P := P - 1; | |
548 | end loop; | |
549 | ||
550 | while P <= Child'Last loop | |
551 | Name_Len := Name_Len + 1; | |
552 | Name_Buffer (Name_Len) := Child (P); | |
553 | P := P + 1; | |
554 | end loop; | |
555 | ||
556 | return Name_Find; | |
557 | end; | |
558 | end New_Child; | |
559 | ||
560 | -------------- | |
561 | -- Uname_Ge -- | |
562 | -------------- | |
563 | ||
564 | function Uname_Ge (Left, Right : Unit_Name_Type) return Boolean is | |
565 | begin | |
566 | return Left = Right or else Uname_Gt (Left, Right); | |
567 | end Uname_Ge; | |
568 | ||
569 | -------------- | |
570 | -- Uname_Gt -- | |
571 | -------------- | |
572 | ||
573 | function Uname_Gt (Left, Right : Unit_Name_Type) return Boolean is | |
574 | begin | |
575 | return Left /= Right and then not Uname_Lt (Left, Right); | |
576 | end Uname_Gt; | |
577 | ||
578 | -------------- | |
579 | -- Uname_Le -- | |
580 | -------------- | |
581 | ||
582 | function Uname_Le (Left, Right : Unit_Name_Type) return Boolean is | |
583 | begin | |
584 | return Left = Right or else Uname_Lt (Left, Right); | |
585 | end Uname_Le; | |
586 | ||
587 | -------------- | |
588 | -- Uname_Lt -- | |
589 | -------------- | |
590 | ||
591 | function Uname_Lt (Left, Right : Unit_Name_Type) return Boolean is | |
592 | Left_Name : String (1 .. Hostparm.Max_Name_Length); | |
593 | Left_Length : Natural; | |
594 | Right_Name : String renames Name_Buffer; | |
595 | Right_Length : Natural renames Name_Len; | |
596 | J : Natural; | |
597 | ||
598 | begin | |
599 | pragma Warnings (Off, Right_Length); | |
600 | -- Suppress warnings on Right_Length, used in pragma Assert | |
601 | ||
602 | if Left = Right then | |
603 | return False; | |
604 | end if; | |
605 | ||
606 | Get_Name_String (Left); | |
607 | Left_Name (1 .. Name_Len + 1) := Name_Buffer (1 .. Name_Len + 1); | |
608 | Left_Length := Name_Len; | |
609 | Get_Name_String (Right); | |
610 | J := 1; | |
611 | ||
612 | loop | |
613 | exit when Left_Name (J) = '%'; | |
614 | ||
615 | if Right_Name (J) = '%' then | |
616 | return False; -- left name is longer | |
617 | end if; | |
618 | ||
619 | pragma Assert (J <= Left_Length and then J <= Right_Length); | |
620 | ||
621 | if Left_Name (J) /= Right_Name (J) then | |
622 | return Left_Name (J) < Right_Name (J); -- parent names different | |
623 | end if; | |
624 | ||
625 | J := J + 1; | |
626 | end loop; | |
627 | ||
628 | -- Come here pointing to % in left name | |
629 | ||
630 | if Right_Name (J) /= '%' then | |
631 | return True; -- right name is longer | |
632 | end if; | |
633 | ||
634 | -- Here the parent names are the same and specs sort low. If neither is | |
635 | -- a spec, then we are comparing the same name and we want a result of | |
636 | -- False in any case. | |
637 | ||
638 | return Left_Name (J + 1) = 's'; | |
639 | end Uname_Lt; | |
640 | ||
641 | --------------------- | |
642 | -- Write_Unit_Name -- | |
643 | --------------------- | |
644 | ||
645 | procedure Write_Unit_Name (N : Unit_Name_Type) is | |
646 | begin | |
647 | Get_Unit_Name_String (N); | |
648 | Write_Str (Name_Buffer (1 .. Name_Len)); | |
649 | end Write_Unit_Name; | |
650 | ||
651 | end Uname; |