| blob | 85ae7055fcdef5f3898c756a4167d2ccd56381a1 |
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-95 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 following should be Ada 2012 units, but it seems
177 -- harmless (and useful) to make then available in Ada 95 mode, since
178 -- they do not deal with Wide_Wide_Character.
186 ---------------------------
187 -- GNAT Special IO Units --
188 ---------------------------
190 -- As further explained elsewhere (see Sem_Ch10), the internal packages of
191 -- Text_IO and Wide_Text_IO are actually implemented as separate children,
192 -- but this fact is intended to be hidden from the user completely. Any
193 -- attempt to WITH one of these units will be diagnosed as an error later
194 -- on, but for now we do not consider these internal implementation units
195 -- (if we did, then we would get a junk warning which would be confusing
196 -- and unnecessary, given that we generate a clear error message).
212 ------------------------
213 -- GNAT Library Units --
214 ------------------------
307 -----------------------------------------------------
308 -- Interface Hierarchy Units from Reference Manual --
309 -----------------------------------------------------
317 ------------------------------------------
318 -- GNAT Defined Additions to Interfaces --
319 ------------------------------------------
332 --------------------------------------------------
333 -- System Hierarchy Units from Reference Manual --
334 --------------------------------------------------
342 --------------------------------------
343 -- GNAT Defined Additions to System --
344 --------------------------------------
359 --------------------
360 -- Ada 2005 Units --
361 --------------------
363 -- The following units should be used only in Ada 05 mode
367 --------------------------------------------------------
368 -- Ada Hierarchy Units from Ada 2005 Reference Manual --
369 --------------------------------------------------------
439 ------------------------------------------------------
440 -- RM Required Additions to Ada 2005 for GNAT Types --
441 ------------------------------------------------------
459 ----------------------------------------
460 -- GNAT Defined Additions to Ada 2005 --
461 ----------------------------------------
475 -- Note: strictly the following should be Ada 2012 units, but it seems
476 -- harmless (and useful) to make then available in Ada 2005 mode.
480 ---------------------------
481 -- GNAT Special IO Units --
482 ---------------------------
484 -- See Ada 95 section for further information. These packages are for the
485 -- implementation of the Wide_Wide_Text_IO generic packages.
494 ------------------------
495 -- GNAT Library Units --
496 ------------------------
501 --------------------
502 -- Ada 2012 Units --
503 --------------------
505 -- The following units should be used only in Ada 2012 mode
517 -----------------------
518 -- Alternative Units --
519 -----------------------
521 -- For some implementation units, there is a unit in the GNAT library
522 -- that has identical functionality that is usable. If we have such a
523 -- case we record the appropriate Unit name in Error_Msg_String.
530 -- Array of alternative unit names
543 -- Array giving mapping
548 ("htable", Shtable'Access),
549 ("os_lib", Sos_lib'Access),
550 ("regexp", Sregexp'Access),
551 ("regpat", Sregpat'Access),
552 ("string", Sstring'Access),
553 ("stusta", Sstusta'Access),
554 ("tasloc", Stasloc'Access),
555 ("utf_32", Sutf_32'Access));
557 ----------------------
558 -- Get_Kind_Of_Unit --
559 ----------------------
561 function Get_Kind_Of_Unit (U : Unit_Number_Type) return Kind_Of_Unit is
562 Fname : constant File_Name_Type := Unit_File_Name (U);
564 begin
565 Error_Msg_Strlen := 0;
567 -- If length of file name is greater than 12, not predefined.
568 -- The value 12 here is an 8 char name with extension .ads.
570 if Length_Of_Name (Fname) > 12 then
571 return Not_Predefined_Unit;
572 end if;
574 -- Otherwise test file name
576 Get_Name_String (Fname);
578 -- Not predefined if file name does not start with a- g- s- i-
580 if Name_Len < 3
583 and then
585 and then
587 and then
589 then
590 return Not_Predefined_Unit;
591 end if;
593 -- Not predefined if file name does not end in .ads. This can
594 -- happen when non-standard file names are being used.
596 if Name_Buffer (Name_Len - 3 .. Name_Len) /= ".ads" then
597 return Not_Predefined_Unit;
598 end if;
600 -- Otherwise normalize file name to 8 characters
602 Name_Len := Name_Len - 4;
603 while Name_Len < 8 loop
604 Name_Len := Name_Len + 1;
606 end loop;
608 -- See if name is in 95 list
610 for J in Non_Imp_File_Names_95'Range loop
611 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_95 (J) then
612 return Ada_95_Unit;
613 end if;
614 end loop;
616 -- See if name is in 2005 list
618 for J in Non_Imp_File_Names_05'Range loop
619 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_05 (J) then
620 return Ada_2005_Unit;
621 end if;
622 end loop;
624 -- See if name is in 2012 list
626 for J in Non_Imp_File_Names_12'Range loop
627 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_12 (J) then
628 return Ada_2012_Unit;
629 end if;
630 end loop;
632 -- Only remaining special possibilities are children of System.RPC and
633 -- System.Garlic and special files of the form System.Aux...
635 Get_Name_String (Unit_Name (U));
637 if Name_Len > 12
638 and then Name_Buffer (1 .. 11) = "system.rpc."
639 then
640 return Ada_95_Unit;
641 end if;
643 if Name_Len > 15
644 and then Name_Buffer (1 .. 14) = "system.garlic."
645 then
646 return Ada_95_Unit;
647 end if;
649 if Name_Len > 11
650 and then Name_Buffer (1 .. 10) = "system.aux"
651 then
652 return Ada_95_Unit;
653 end if;
655 -- All tests failed, this is definitely an implementation unit. See if
656 -- we have an alternative name.
658 Get_Name_String (Fname);
660 if Name_Len in 11 .. 12
661 and then Name_Buffer (1 .. 2) = "s-"
662 and then Name_Buffer (Name_Len - 3 .. Name_Len) = ".ads"
663 then
664 for J in Map_Array'Range loop
665 if (Name_Len = 12 and then
666 Name_Buffer (3 .. 8) = Map_Array (J).Fname)
667 or else
668 (Name_Len = 11 and then
669 Name_Buffer (3 .. 7) = Map_Array (J).Fname (1 .. 5))
670 then
671 Error_Msg_Strlen := Map_Array (J).Aname'Length;
672 Error_Msg_String (1 .. Error_Msg_Strlen) :=
673 Map_Array (J).Aname.all;
674 end if;
675 end loop;
676 end if;
678 return Implementation_Unit;
679 end Get_Kind_Of_Unit;
681 -------------------
682 -- Is_Known_Unit --
683 -------------------
685 function Is_Known_Unit (Nam : Node_Id) return Boolean is
686 Unam : Unit_Name_Type;
687 Fnam : File_Name_Type;
689 begin
690 -- If selector is not an identifier (e.g. it is a character literal or
691 -- some junk from a previous error), then definitely not a known unit.
693 if Nkind (Selector_Name (Nam)) /= N_Identifier then
694 return False;
695 end if;
697 -- Otherwise get corresponding file name
699 Unam := Get_Unit_Name (Nam);
700 Fnam := Get_File_Name (Unam, Subunit => False);
701 Get_Name_String (Fnam);
703 -- Remove extension from file name
705 if Name_Buffer (Name_Len - 3 .. Name_Len) = ".adb" then
706 Name_Len := Name_Len - 4;
707 else
708 return False;
709 end if;
711 -- Pad name to 8 characters
713 while Name_Len < 8 loop
714 Name_Len := Name_Len + 1;
716 end loop;
718 -- If length more than 8, definitely not a match
720 if Name_Len /= 8 then
721 return False;
722 end if;
724 -- If length is 8, search our tables
726 for J in Non_Imp_File_Names_95'Range loop
727 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_95 (J) then
728 return True;
729 end if;
730 end loop;
732 for J in Non_Imp_File_Names_05'Range loop
733 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_05 (J) then
734 return True;
735 end if;
736 end loop;
738 -- If not found, not known
740 return False;
742 -- A safety guard, if we get an exception during this processing then it
743 -- is most likely the result of a previous error, or a peculiar case we
744 -- have not thought of. Since this routine is only used for error message
745 -- refinement, we will just return False.
747 exception
748 when others =>
749 return False;
750 end Is_Known_Unit;
752 end Impunit;