| blob | cbd489064ca4baff2bad4dfeb2cbd3c1f8385e97 |
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- I M P U N I T --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2000-2010, 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 ------------------------------------------------------------------------------
34 -- Note: this package body is used by GPS and GNATBench to supply a list of
35 -- entries for help on available library routines.
42 ------------------
43 -- Ada 95 Units --
44 ------------------
46 -- The following is a giant string list containing the names of all non-
47 -- implementation internal files, i.e. the complete list of files for
48 -- internal units which a program may legitimately WITH when operating in
49 -- either Ada 95 or Ada 05 mode.
51 -- Note that this list should match the list of units documented in the
52 -- "GNAT Library" section of the GNAT Reference Manual. A unit listed here
53 -- must either be documented in that section or described in the Ada RM.
57 ------------------------------------------------------
58 -- Ada Hierarchy Units from Ada-83 Reference Manual --
59 ------------------------------------------------------
119 -------------------------------------------------
120 -- RM Required Additions to Ada for GNAT Types --
121 -------------------------------------------------
147 -----------------------------------
148 -- GNAT Defined Additions to Ada --
149 -----------------------------------
169 -- Note: strictly the next two should be Ada 2005 units, but it seems
170 -- harmless (and useful) to make then available in Ada 95 mode, since
171 -- they only deal with Wide_Character, not Wide_Wide_Character.
176 -- Note: strictly the next two should be Ada 2012 units, but it seems
177 -- harmless (and useful) to make then available in Ada 95 mode, since
178 -- they only deal with Wide_Character, not Wide_Wide_Character.
184 ---------------------------
185 -- GNAT Special IO Units --
186 ---------------------------
188 -- As further explained elsewhere (see Sem_Ch10), the internal packages of
189 -- Text_IO and Wide_Text_IO are actually implemented as separate children,
190 -- but this fact is intended to be hidden from the user completely. Any
191 -- attempt to WITH one of these units will be diagnosed as an error later
192 -- on, but for now we do not consider these internal implementation units
193 -- (if we did, then we would get a junk warning which would be confusing
194 -- and unnecessary, given that we generate a clear error message).
210 ------------------------
211 -- GNAT Library Units --
212 ------------------------
305 -----------------------------------------------------
306 -- Interface Hierarchy Units from Reference Manual --
307 -----------------------------------------------------
315 ------------------------------------------
316 -- GNAT Defined Additions to Interfaces --
317 ------------------------------------------
330 --------------------------------------------------
331 -- System Hierarchy Units from Reference Manual --
332 --------------------------------------------------
340 --------------------------------------
341 -- GNAT Defined Additions to System --
342 --------------------------------------
357 --------------------
358 -- Ada 2005 Units --
359 --------------------
361 -- The following units should be used only in Ada 05 mode
365 --------------------------------------------------------
366 -- Ada Hierarchy Units from Ada 2005 Reference Manual --
367 --------------------------------------------------------
434 ------------------------------------------------------
435 -- RM Required Additions to Ada 2005 for GNAT Types --
436 ------------------------------------------------------
454 ----------------------------------------
455 -- GNAT Defined Additions to Ada 2005 --
456 ----------------------------------------
470 -- Note: strictly the following should be Ada 2012 units, but it seems
471 -- harmless (and useful) to make then available in Ada 2005 mode.
475 ---------------------------
476 -- GNAT Special IO Units --
477 ---------------------------
479 -- See Ada 95 section for further information. These packages are for the
480 -- implementation of the Wide_Wide_Text_IO generic packages.
489 ------------------------
490 -- GNAT Library Units --
491 ------------------------
496 -----------------------
497 -- Alternative Units --
498 -----------------------
500 -- For some implementation units, there is a unit in the GNAT library
501 -- that has identical functionality that is usable. If we have such a
502 -- case we record the appropriate Unit name in Error_Msg_String.
509 -- Array of alternative unit names
522 -- Array giving mapping
527 ("htable", Shtable'Access),
528 ("os_lib", Sos_lib'Access),
529 ("regexp", Sregexp'Access),
530 ("regpat", Sregpat'Access),
531 ("string", Sstring'Access),
532 ("stusta", Sstusta'Access),
533 ("tasloc", Stasloc'Access),
534 ("utf_32", Sutf_32'Access));
536 ----------------------
537 -- Get_Kind_Of_Unit --
538 ----------------------
540 function Get_Kind_Of_Unit (U : Unit_Number_Type) return Kind_Of_Unit is
541 Fname : constant File_Name_Type := Unit_File_Name (U);
543 begin
544 Error_Msg_Strlen := 0;
546 -- If length of file name is greater than 12, not predefined.
547 -- The value 12 here is an 8 char name with extension .ads.
549 if Length_Of_Name (Fname) > 12 then
550 return Not_Predefined_Unit;
551 end if;
553 -- Otherwise test file name
555 Get_Name_String (Fname);
557 -- Not predefined if file name does not start with a- g- s- i-
559 if Name_Len < 3
562 and then
564 and then
566 and then
568 then
569 return Not_Predefined_Unit;
570 end if;
572 -- Not predefined if file name does not end in .ads. This can
573 -- happen when non-standard file names are being used.
575 if Name_Buffer (Name_Len - 3 .. Name_Len) /= ".ads" then
576 return Not_Predefined_Unit;
577 end if;
579 -- Otherwise normalize file name to 8 characters
581 Name_Len := Name_Len - 4;
582 while Name_Len < 8 loop
583 Name_Len := Name_Len + 1;
585 end loop;
587 -- See if name is in 95 list
589 for J in Non_Imp_File_Names_95'Range loop
590 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_95 (J) then
591 return Ada_95_Unit;
592 end if;
593 end loop;
595 -- See if name is in 05 list
597 for J in Non_Imp_File_Names_05'Range loop
598 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_05 (J) then
599 return Ada_05_Unit;
600 end if;
601 end loop;
603 -- Only remaining special possibilities are children of System.RPC and
604 -- System.Garlic and special files of the form System.Aux...
606 Get_Name_String (Unit_Name (U));
608 if Name_Len > 12
609 and then Name_Buffer (1 .. 11) = "system.rpc."
610 then
611 return Ada_95_Unit;
612 end if;
614 if Name_Len > 15
615 and then Name_Buffer (1 .. 14) = "system.garlic."
616 then
617 return Ada_95_Unit;
618 end if;
620 if Name_Len > 11
621 and then Name_Buffer (1 .. 10) = "system.aux"
622 then
623 return Ada_95_Unit;
624 end if;
626 -- All tests failed, this is definitely an implementation unit. See if
627 -- we have an alternative name.
629 Get_Name_String (Fname);
631 if Name_Len in 11 .. 12
632 and then Name_Buffer (1 .. 2) = "s-"
633 and then Name_Buffer (Name_Len - 3 .. Name_Len) = ".ads"
634 then
635 for J in Map_Array'Range loop
636 if (Name_Len = 12 and then
637 Name_Buffer (3 .. 8) = Map_Array (J).Fname)
638 or else
639 (Name_Len = 11 and then
640 Name_Buffer (3 .. 7) = Map_Array (J).Fname (1 .. 5))
641 then
642 Error_Msg_Strlen := Map_Array (J).Aname'Length;
643 Error_Msg_String (1 .. Error_Msg_Strlen) :=
644 Map_Array (J).Aname.all;
645 end if;
646 end loop;
647 end if;
649 return Implementation_Unit;
650 end Get_Kind_Of_Unit;
652 -------------------
653 -- Is_Known_Unit --
654 -------------------
656 function Is_Known_Unit (Nam : Node_Id) return Boolean is
657 Unam : Unit_Name_Type;
658 Fnam : File_Name_Type;
660 begin
661 -- If selector is not an identifier (e.g. it is a character literal or
662 -- some junk from a previous error), then definitely not a known unit.
664 if Nkind (Selector_Name (Nam)) /= N_Identifier then
665 return False;
666 end if;
668 -- Otherwise get corresponding file name
670 Unam := Get_Unit_Name (Nam);
671 Fnam := Get_File_Name (Unam, Subunit => False);
672 Get_Name_String (Fnam);
674 -- Remove extension from file name
676 if Name_Buffer (Name_Len - 3 .. Name_Len) = ".adb" then
677 Name_Len := Name_Len - 4;
678 else
679 return False;
680 end if;
682 -- Pad name to 8 characters
684 while Name_Len < 8 loop
685 Name_Len := Name_Len + 1;
687 end loop;
689 -- If length more than 8, definitely not a match
691 if Name_Len /= 8 then
692 return False;
693 end if;
695 -- If length is 8, search our tables
697 for J in Non_Imp_File_Names_95'Range loop
698 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_95 (J) then
699 return True;
700 end if;
701 end loop;
703 for J in Non_Imp_File_Names_05'Range loop
704 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_05 (J) then
705 return True;
706 end if;
707 end loop;
709 -- If not found, not known
711 return False;
713 -- A safety guard, if we get an exception during this processing then it
714 -- is most likely the result of a previous error, or a peculiar case we
715 -- have not thought of. Since this routine is only used for error message
716 -- refinement, we will just return False.
718 exception
719 when others =>
720 return False;
721 end Is_Known_Unit;
723 end Impunit;