projects / gcc.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
decl.c (validate_size): Set minimum size for fat pointers same as access types.
[gcc.git] / gcc / ada / sem_elim.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- S E M _ E L I M --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1997-2007, 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
26 with Atree; use Atree;
27 with Einfo; use Einfo;
28 with Errout; use Errout;
29 with Namet; use Namet;
30 with Nlists; use Nlists;
31 with Sem_Prag; use Sem_Prag;
32 with Sinput; use Sinput;
33 with Sinfo; use Sinfo;
34 with Snames; use Snames;
35 with Stand; use Stand;
36 with Stringt; use Stringt;
37 with Table;
38
39 with GNAT.HTable; use GNAT.HTable;
40
41 package body Sem_Elim is
42
43 No_Elimination : Boolean;
44 -- Set True if no Eliminate pragmas active
45
46 ---------------------
47 -- Data Structures --
48 ---------------------
49
50 -- A single pragma Eliminate is represented by the following record
51
52 type Elim_Data;
53 type Access_Elim_Data is access Elim_Data;
54
55 type Names is array (Nat range <>) of Name_Id;
56 -- Type used to represent set of names. Used for names in Unit_Name
57 -- and also the set of names in Argument_Types.
58
59 type Access_Names is access Names;
60
61 type Elim_Data is record
62
63 Unit_Name : Access_Names;
64 -- Unit name, broken down into a set of names (e.g. A.B.C is
65 -- represented as Name_Id values for A, B, C in sequence).
66
67 Entity_Name : Name_Id;
68 -- Entity name if Entity parameter if present. If no Entity parameter
69 -- was supplied, then Entity_Node is set to Empty, and the Entity_Name
70 -- field contains the last identifier name in the Unit_Name.
71
72 Entity_Scope : Access_Names;
73 -- Static scope of the entity within the compilation unit represented by
74 -- Unit_Name.
75
76 Entity_Node : Node_Id;
77 -- Save node of entity argument, for posting error messages. Set
78 -- to Empty if there is no entity argument.
79
80 Parameter_Types : Access_Names;
81 -- Set to set of names given for parameter types. If no parameter
82 -- types argument is present, this argument is set to null.
83
84 Result_Type : Name_Id;
85 -- Result type name if Result_Types parameter present, No_Name if not
86
87 Source_Location : Name_Id;
88 -- String describing the source location of subprogram defining name if
89 -- Source_Location parameter present, No_Name if not
90
91 Hash_Link : Access_Elim_Data;
92 -- Link for hash table use
93
94 Homonym : Access_Elim_Data;
95 -- Pointer to next entry with same key
96
97 Prag : Node_Id;
98 -- Node_Id for Eliminate pragma
99
100 end record;
101
102 ----------------
103 -- Hash_Table --
104 ----------------
105
106 -- Setup hash table using the Entity_Name field as the hash key
107
108 subtype Element is Elim_Data;
109 subtype Elmt_Ptr is Access_Elim_Data;
110
111 subtype Key is Name_Id;
112
113 type Header_Num is range 0 .. 1023;
114
115 Null_Ptr : constant Elmt_Ptr := null;
116
117 ----------------------
118 -- Hash_Subprograms --
119 ----------------------
120
121 package Hash_Subprograms is
122
123 function Equal (F1, F2 : Key) return Boolean;
124 pragma Inline (Equal);
125
126 function Get_Key (E : Elmt_Ptr) return Key;
127 pragma Inline (Get_Key);
128
129 function Hash (F : Key) return Header_Num;
130 pragma Inline (Hash);
131
132 function Next (E : Elmt_Ptr) return Elmt_Ptr;
133 pragma Inline (Next);
134
135 procedure Set_Next (E : Elmt_Ptr; Next : Elmt_Ptr);
136 pragma Inline (Set_Next);
137
138 end Hash_Subprograms;
139
140 package body Hash_Subprograms is
141
142 -----------
143 -- Equal --
144 -----------
145
146 function Equal (F1, F2 : Key) return Boolean is
147 begin
148 return F1 = F2;
149 end Equal;
150
151 -------------
152 -- Get_Key --
153 -------------
154
155 function Get_Key (E : Elmt_Ptr) return Key is
156 begin
157 return E.Entity_Name;
158 end Get_Key;
159
160 ----------
161 -- Hash --
162 ----------
163
164 function Hash (F : Key) return Header_Num is
165 begin
166 return Header_Num (Int (F) mod 1024);
167 end Hash;
168
169 ----------
170 -- Next --
171 ----------
172
173 function Next (E : Elmt_Ptr) return Elmt_Ptr is
174 begin
175 return E.Hash_Link;
176 end Next;
177
178 --------------
179 -- Set_Next --
180 --------------
181
182 procedure Set_Next (E : Elmt_Ptr; Next : Elmt_Ptr) is
183 begin
184 E.Hash_Link := Next;
185 end Set_Next;
186 end Hash_Subprograms;
187
188 ------------
189 -- Tables --
190 ------------
191
192 -- The following table records the data for each pragmas, using the
193 -- entity name as the hash key for retrieval. Entries in this table
194 -- are set by Process_Eliminate_Pragma and read by Check_Eliminated.
195
196 package Elim_Hash_Table is new Static_HTable (
197 Header_Num => Header_Num,
198 Element => Element,
199 Elmt_Ptr => Elmt_Ptr,
200 Null_Ptr => Null_Ptr,
201 Set_Next => Hash_Subprograms.Set_Next,
202 Next => Hash_Subprograms.Next,
203 Key => Key,
204 Get_Key => Hash_Subprograms.Get_Key,
205 Hash => Hash_Subprograms.Hash,
206 Equal => Hash_Subprograms.Equal);
207
208 -- The following table records entities for subprograms that are
209 -- eliminated, and corresponding eliminate pragmas that caused the
210 -- elimination. Entries in this table are set by Check_Eliminated
211 -- and read by Eliminate_Error_Msg.
212
213 type Elim_Entity_Entry is record
214 Prag : Node_Id;
215 Subp : Entity_Id;
216 end record;
217
218 package Elim_Entities is new Table.Table (
219 Table_Component_Type => Elim_Entity_Entry,
220 Table_Index_Type => Name_Id'Base,
221 Table_Low_Bound => First_Name_Id,
222 Table_Initial => 50,
223 Table_Increment => 200,
224 Table_Name => "Elim_Entries");
225
226 ----------------------
227 -- Check_Eliminated --
228 ----------------------
229
230 procedure Check_Eliminated (E : Entity_Id) is
231 Elmt : Access_Elim_Data;
232 Scop : Entity_Id;
233 Form : Entity_Id;
234
235 function Original_Chars (S : Entity_Id) return Name_Id;
236 -- If the candidate subprogram is a protected operation of a single
237 -- protected object, the scope of the operation is the created
238 -- protected type, and we have to retrieve the original name of
239 -- the object.
240
241 --------------------
242 -- Original_Chars --
243 --------------------
244
245 function Original_Chars (S : Entity_Id) return Name_Id is
246 begin
247 if Ekind (S) /= E_Protected_Type
248 or else Comes_From_Source (S)
249 then
250 return Chars (S);
251 else
252 return Chars (Defining_Identifier (Original_Node (Parent (S))));
253 end if;
254 end Original_Chars;
255
256 -- Start of processing for Check_Eliminated
257
258 begin
259 if No_Elimination then
260 return;
261
262 -- Elimination of objects and types is not implemented yet
263
264 elsif Ekind (E) not in Subprogram_Kind then
265 return;
266 end if;
267
268 -- Loop through homonyms for this key
269
270 Elmt := Elim_Hash_Table.Get (Chars (E));
271 while Elmt /= null loop
272 declare
273 procedure Set_Eliminated;
274 -- Set current subprogram entity as eliminated
275
276 --------------------
277 -- Set_Eliminated --
278 --------------------
279
280 procedure Set_Eliminated is
281 begin
282 -- Never try to eliminate dispatching operation, since we
283 -- can't properly process the eliminated result. This could
284 -- be fixed, but is not worth it.
285
286 if not Is_Dispatching_Operation (E) then
287 Set_Is_Eliminated (E);
288 Elim_Entities.Append ((Prag => Elmt.Prag, Subp => E));
289 end if;
290 end Set_Eliminated;
291
292 begin
293 -- First we check that the name of the entity matches
294
295 if Elmt.Entity_Name /= Chars (E) then
296 goto Continue;
297 end if;
298
299 -- Then we need to see if the static scope matches within the
300 -- compilation unit.
301
302 -- At the moment, gnatelim does not consider block statements as
303 -- scopes (even if a block is named)
304
305 Scop := Scope (E);
306 while Ekind (Scop) = E_Block loop
307 Scop := Scope (Scop);
308 end loop;
309
310 if Elmt.Entity_Scope /= null then
311 for J in reverse Elmt.Entity_Scope'Range loop
312 if Elmt.Entity_Scope (J) /= Original_Chars (Scop) then
313 goto Continue;
314 end if;
315
316 Scop := Scope (Scop);
317 while Ekind (Scop) = E_Block loop
318 Scop := Scope (Scop);
319 end loop;
320
321 if not Is_Compilation_Unit (Scop) and then J = 1 then
322 goto Continue;
323 end if;
324 end loop;
325 end if;
326
327 -- Now see if compilation unit matches
328
329 for J in reverse Elmt.Unit_Name'Range loop
330 if Elmt.Unit_Name (J) /= Chars (Scop) then
331 goto Continue;
332 end if;
333
334 Scop := Scope (Scop);
335 while Ekind (Scop) = E_Block loop
336 Scop := Scope (Scop);
337 end loop;
338
339 if Scop /= Standard_Standard and then J = 1 then
340 goto Continue;
341 end if;
342 end loop;
343
344 if Scop /= Standard_Standard then
345 goto Continue;
346 end if;
347
348 -- Check for case of given entity is a library level subprogram
349 -- and we have the single parameter Eliminate case, a match!
350
351 if Is_Compilation_Unit (E)
352 and then Is_Subprogram (E)
353 and then No (Elmt.Entity_Node)
354 then
355 Set_Eliminated;
356 return;
357
358 -- Check for case of type or object with two parameter case
359
360 elsif (Is_Type (E) or else Is_Object (E))
361 and then Elmt.Result_Type = No_Name
362 and then Elmt.Parameter_Types = null
363 then
364 Set_Eliminated;
365 return;
366
367 -- Check for case of subprogram
368
369 elsif Ekind (E) = E_Function
370 or else Ekind (E) = E_Procedure
371 then
372 -- If Source_Location present, then see if it matches
373
374 if Elmt.Source_Location /= No_Name then
375 Get_Name_String (Elmt.Source_Location);
376
377 declare
378 Sloc_Trace : constant String :=
379 Name_Buffer (1 .. Name_Len);
380
381 Idx : Natural := Sloc_Trace'First;
382 -- Index in Sloc_Trace, if equals to 0, then we have
383 -- completely traversed Sloc_Trace
384
385 Last : constant Natural := Sloc_Trace'Last;
386
387 P : Source_Ptr;
388 Sindex : Source_File_Index;
389
390 function File_Name_Match return Boolean;
391 -- This function is supposed to be called when Idx points
392 -- to the beginning of the new file name, and Name_Buffer
393 -- is set to contain the name of the proper source file
394 -- from the chain corresponding to the Sloc of E. First
395 -- it checks that these two files have the same name. If
396 -- this check is successful, moves Idx to point to the
397 -- beginning of the column number.
398
399 function Line_Num_Match return Boolean;
400 -- This function is supposed to be called when Idx points
401 -- to the beginning of the column number, and P is
402 -- set to point to the proper Sloc the chain
403 -- corresponding to the Sloc of E. First it checks that
404 -- the line number Idx points on and the line number
405 -- corresponding to P are the same. If this check is
406 -- successful, moves Idx to point to the beginning of
407 -- the next file name in Sloc_Trace. If there is no file
408 -- name any more, Idx is set to 0.
409
410 function Different_Trace_Lengths return Boolean;
411 -- From Idx and P, defines if there are in both traces
412 -- more element(s) in the instantiation chains. Returns
413 -- False if one trace contains more element(s), but
414 -- another does not. If both traces contains more
415 -- elements (that is, the function returns False), moves
416 -- P ahead in the chain corresponding to E, recomputes
417 -- Sindex and sets the name of the corresponding file in
418 -- Name_Buffer
419
420 function Skip_Spaces return Natural;
421 -- If Sloc_Trace (Idx) is not space character, returns
422 -- Idx. Otherwise returns the index of the nearest
423 -- non-space character in Sloc_Trace to the right of
424 -- Idx. Returns 0 if there is no such character.
425
426 -----------------------------
427 -- Different_Trace_Lengths --
428 -----------------------------
429
430 function Different_Trace_Lengths return Boolean is
431 begin
432 P := Instantiation (Sindex);
433
434 if (P = No_Location and then Idx /= 0)
435 or else
436 (P /= No_Location and then Idx = 0)
437 then
438 return True;
439
440 else
441 if P /= No_Location then
442 Sindex := Get_Source_File_Index (P);
443 Get_Name_String (File_Name (Sindex));
444 end if;
445
446 return False;
447 end if;
448 end Different_Trace_Lengths;
449
450 ---------------------
451 -- File_Name_Match --
452 ---------------------
453
454 function File_Name_Match return Boolean is
455 Tmp_Idx : Natural;
456 End_Idx : Natural;
457
458 begin
459 if Idx = 0 then
460 return False;
461 end if;
462
463 -- Find first colon. If no colon, then return False.
464 -- If there is a colon, Tmp_Idx is set to point just
465 -- before the colon.
466
467 Tmp_Idx := Idx - 1;
468 loop
469 if Tmp_Idx >= Last then
470 return False;
471 elsif Sloc_Trace (Tmp_Idx + 1) = ':' then
472 exit;
473 else
474 Tmp_Idx := Tmp_Idx + 1;
475 end if;
476 end loop;
477
478 -- Find last non-space before this colon. If there
479 -- is no no space character before this colon, then
480 -- return False. Otherwise, End_Idx set to point to
481 -- this non-space character.
482
483 End_Idx := Tmp_Idx;
484 loop
485 if End_Idx < Idx then
486 return False;
487 elsif Sloc_Trace (End_Idx) /= ' ' then
488 exit;
489 else
490 End_Idx := End_Idx - 1;
491 end if;
492 end loop;
493
494 -- Now see if file name matches what is in Name_Buffer
495 -- and if so, step Idx past it and return True. If the
496 -- name does not match, return False.
497
498 if Sloc_Trace (Idx .. End_Idx) =
499 Name_Buffer (1 .. Name_Len)
500 then
501 Idx := Tmp_Idx + 2;
502 Idx := Skip_Spaces;
503 return True;
504 else
505 return False;
506 end if;
507 end File_Name_Match;
508
509 --------------------
510 -- Line_Num_Match --
511 --------------------
512
513 function Line_Num_Match return Boolean is
514 N : Int := 0;
515
516 begin
517 if Idx = 0 then
518 return False;
519 end if;
520
521 while Idx <= Last
522 and then Sloc_Trace (Idx) in '0' .. '9'
523 loop
524 N := N * 10 +
525 (Character'Pos (Sloc_Trace (Idx)) -
526 Character'Pos ('0'));
527 Idx := Idx + 1;
528 end loop;
529
530 if Get_Physical_Line_Number (P) =
531 Physical_Line_Number (N)
532 then
533 while Idx <= Last and then
534 Sloc_Trace (Idx) /= '['
535 loop
536 Idx := Idx + 1;
537 end loop;
538
539 if Idx <= Last and then
540 Sloc_Trace (Idx) = '['
541 then
542 Idx := Idx + 1;
543 Idx := Skip_Spaces;
544 else
545 Idx := 0;
546 end if;
547
548 return True;
549
550 else
551 return False;
552 end if;
553 end Line_Num_Match;
554
555 -----------------
556 -- Skip_Spaces --
557 -----------------
558
559 function Skip_Spaces return Natural is
560 Res : Natural;
561
562 begin
563 Res := Idx;
564 while Sloc_Trace (Res) = ' ' loop
565 Res := Res + 1;
566
567 if Res > Last then
568 Res := 0;
569 exit;
570 end if;
571 end loop;
572
573 return Res;
574 end Skip_Spaces;
575
576 begin
577 P := Sloc (E);
578 Sindex := Get_Source_File_Index (P);
579 Get_Name_String (File_Name (Sindex));
580
581 Idx := Skip_Spaces;
582 while Idx > 0 loop
583 if not File_Name_Match then
584 goto Continue;
585 elsif not Line_Num_Match then
586 goto Continue;
587 end if;
588
589 if Different_Trace_Lengths then
590 goto Continue;
591 end if;
592 end loop;
593 end;
594 end if;
595
596 -- If we have a Result_Type, then we must have a function
597 -- with the proper result type
598
599 if Elmt.Result_Type /= No_Name then
600 if Ekind (E) /= E_Function
601 or else Chars (Etype (E)) /= Elmt.Result_Type
602 then
603 goto Continue;
604 end if;
605 end if;
606
607 -- If we have Parameter_Types, they must match
608
609 if Elmt.Parameter_Types /= null then
610 Form := First_Formal (E);
611
612 if No (Form)
613 and then Elmt.Parameter_Types'Length = 1
614 and then Elmt.Parameter_Types (1) = No_Name
615 then
616 -- Parameterless procedure matches
617
618 null;
619
620 elsif Elmt.Parameter_Types = null then
621 goto Continue;
622
623 else
624 for J in Elmt.Parameter_Types'Range loop
625 if No (Form)
626 or else
627 Chars (Etype (Form)) /= Elmt.Parameter_Types (J)
628 then
629 goto Continue;
630 else
631 Next_Formal (Form);
632 end if;
633 end loop;
634
635 if Present (Form) then
636 goto Continue;
637 end if;
638 end if;
639 end if;
640
641 -- If we fall through, this is match
642
643 Set_Eliminated;
644 return;
645 end if;
646 end;
647
648 <<Continue>>
649 Elmt := Elmt.Homonym;
650 end loop;
651
652 return;
653 end Check_Eliminated;
654
655 -------------------------
656 -- Eliminate_Error_Msg --
657 -------------------------
658
659 procedure Eliminate_Error_Msg (N : Node_Id; E : Entity_Id) is
660 begin
661 for J in Elim_Entities.First .. Elim_Entities.Last loop
662 if E = Elim_Entities.Table (J).Subp then
663 Error_Msg_Sloc := Sloc (Elim_Entities.Table (J).Prag);
664 Error_Msg_NE ("cannot call subprogram & eliminated #", N, E);
665 return;
666 end if;
667 end loop;
668
669 -- Should never fall through, since entry should be in table
670
671 raise Program_Error;
672 end Eliminate_Error_Msg;
673
674 ----------------
675 -- Initialize --
676 ----------------
677
678 procedure Initialize is
679 begin
680 Elim_Hash_Table.Reset;
681 Elim_Entities.Init;
682 No_Elimination := True;
683 end Initialize;
684
685 ------------------------------
686 -- Process_Eliminate_Pragma --
687 ------------------------------
688
689 procedure Process_Eliminate_Pragma
690 (Pragma_Node : Node_Id;
691 Arg_Unit_Name : Node_Id;
692 Arg_Entity : Node_Id;
693 Arg_Parameter_Types : Node_Id;
694 Arg_Result_Type : Node_Id;
695 Arg_Source_Location : Node_Id)
696 is
697 Data : constant Access_Elim_Data := new Elim_Data;
698 -- Build result data here
699
700 Elmt : Access_Elim_Data;
701
702 Num_Names : Nat := 0;
703 -- Number of names in unit name
704
705 Lit : Node_Id;
706 Arg_Ent : Entity_Id;
707 Arg_Uname : Node_Id;
708
709 function OK_Selected_Component (N : Node_Id) return Boolean;
710 -- Test if N is a selected component with all identifiers, or a
711 -- selected component whose selector is an operator symbol. As a
712 -- side effect if result is True, sets Num_Names to the number
713 -- of names present (identifiers and operator if any).
714
715 ---------------------------
716 -- OK_Selected_Component --
717 ---------------------------
718
719 function OK_Selected_Component (N : Node_Id) return Boolean is
720 begin
721 if Nkind (N) = N_Identifier
722 or else Nkind (N) = N_Operator_Symbol
723 then
724 Num_Names := Num_Names + 1;
725 return True;
726
727 elsif Nkind (N) = N_Selected_Component then
728 return OK_Selected_Component (Prefix (N))
729 and then OK_Selected_Component (Selector_Name (N));
730
731 else
732 return False;
733 end if;
734 end OK_Selected_Component;
735
736 -- Start of processing for Process_Eliminate_Pragma
737
738 begin
739 Data.Prag := Pragma_Node;
740 Error_Msg_Name_1 := Name_Eliminate;
741
742 -- Process Unit_Name argument
743
744 if Nkind (Arg_Unit_Name) = N_Identifier then
745 Data.Unit_Name := new Names'(1 => Chars (Arg_Unit_Name));
746 Num_Names := 1;
747
748 elsif OK_Selected_Component (Arg_Unit_Name) then
749 Data.Unit_Name := new Names (1 .. Num_Names);
750
751 Arg_Uname := Arg_Unit_Name;
752 for J in reverse 2 .. Num_Names loop
753 Data.Unit_Name (J) := Chars (Selector_Name (Arg_Uname));
754 Arg_Uname := Prefix (Arg_Uname);
755 end loop;
756
757 Data.Unit_Name (1) := Chars (Arg_Uname);
758
759 else
760 Error_Msg_N
761 ("wrong form for Unit_Name parameter of pragma%", Arg_Unit_Name);
762 return;
763 end if;
764
765 -- Process Entity argument
766
767 if Present (Arg_Entity) then
768 Num_Names := 0;
769
770 if Nkind (Arg_Entity) = N_Identifier
771 or else Nkind (Arg_Entity) = N_Operator_Symbol
772 then
773 Data.Entity_Name := Chars (Arg_Entity);
774 Data.Entity_Node := Arg_Entity;
775 Data.Entity_Scope := null;
776
777 elsif OK_Selected_Component (Arg_Entity) then
778 Data.Entity_Scope := new Names (1 .. Num_Names - 1);
779 Data.Entity_Name := Chars (Selector_Name (Arg_Entity));
780 Data.Entity_Node := Arg_Entity;
781
782 Arg_Ent := Prefix (Arg_Entity);
783 for J in reverse 2 .. Num_Names - 1 loop
784 Data.Entity_Scope (J) := Chars (Selector_Name (Arg_Ent));
785 Arg_Ent := Prefix (Arg_Ent);
786 end loop;
787
788 Data.Entity_Scope (1) := Chars (Arg_Ent);
789
790 elsif Is_Config_Static_String (Arg_Entity) then
791 Data.Entity_Name := Name_Find;
792 Data.Entity_Node := Arg_Entity;
793
794 else
795 return;
796 end if;
797 else
798 Data.Entity_Node := Empty;
799 Data.Entity_Name := Data.Unit_Name (Num_Names);
800 end if;
801
802 -- Process Parameter_Types argument
803
804 if Present (Arg_Parameter_Types) then
805
806 -- Here for aggregate case
807
808 if Nkind (Arg_Parameter_Types) = N_Aggregate then
809 Data.Parameter_Types :=
810 new Names
811 (1 .. List_Length (Expressions (Arg_Parameter_Types)));
812
813 Lit := First (Expressions (Arg_Parameter_Types));
814 for J in Data.Parameter_Types'Range loop
815 if Is_Config_Static_String (Lit) then
816 Data.Parameter_Types (J) := Name_Find;
817 Next (Lit);
818 else
819 return;
820 end if;
821 end loop;
822
823 -- Otherwise we must have case of one name, which looks like a
824 -- parenthesized literal rather than an aggregate.
825
826 elsif Paren_Count (Arg_Parameter_Types) /= 1 then
827 Error_Msg_N
828 ("wrong form for argument of pragma Eliminate",
829 Arg_Parameter_Types);
830 return;
831
832 elsif Is_Config_Static_String (Arg_Parameter_Types) then
833 String_To_Name_Buffer (Strval (Arg_Parameter_Types));
834
835 if Name_Len = 0 then
836
837 -- Parameterless procedure
838
839 Data.Parameter_Types := new Names'(1 => No_Name);
840
841 else
842 Data.Parameter_Types := new Names'(1 => Name_Find);
843 end if;
844
845 else
846 return;
847 end if;
848 end if;
849
850 -- Process Result_Types argument
851
852 if Present (Arg_Result_Type) then
853 if Is_Config_Static_String (Arg_Result_Type) then
854 Data.Result_Type := Name_Find;
855 else
856 return;
857 end if;
858
859 -- Here if no Result_Types argument
860
861 else
862 Data.Result_Type := No_Name;
863 end if;
864
865 -- Process Source_Location argument
866
867 if Present (Arg_Source_Location) then
868 if Is_Config_Static_String (Arg_Source_Location) then
869 Data.Source_Location := Name_Find;
870 else
871 return;
872 end if;
873 else
874 Data.Source_Location := No_Name;
875 end if;
876
877 Elmt := Elim_Hash_Table.Get (Hash_Subprograms.Get_Key (Data));
878
879 -- If we already have an entry with this same key, then link
880 -- it into the chain of entries for this key.
881
882 if Elmt /= null then
883 Data.Homonym := Elmt.Homonym;
884 Elmt.Homonym := Data;
885
886 -- Otherwise create a new entry
887
888 else
889 Elim_Hash_Table.Set (Data);
890 end if;
891
892 No_Elimination := False;
893 end Process_Eliminate_Pragma;
894
895 end Sem_Elim;