| blob | ca53594fa7ccab1227ec10750fa8927c6fb29387 |
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-2014, 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 ------------------------------------------------------------------------------
35 -- Note: this package body is used by GPS and GNATBench to supply a list of
36 -- entries for help on available library routines.
44 -- 8 character name of unit
47 -- True if unit is RM defined. False for any unit that is implementation
48 -- defined (and thus not with'able in No_Implementation_Units mode).
55 -- Short hand for RM_Defined values in lists below
57 ------------------
58 -- Ada 95 Units --
59 ------------------
61 -- The following is a giant string list containing the names of all non-
62 -- implementation internal files, i.e. the complete list of files for
63 -- internal units which a program may legitimately WITH when operating in
64 -- either Ada 95 or Ada 2005 mode.
66 -- Note that this list should match the list of units documented in the
67 -- "GNAT Library" section of the GNAT Reference Manual. A unit listed here
68 -- must either be documented in that section or described in the Ada RM.
72 ------------------------------------------------------
73 -- Ada Hierarchy Units from Ada-95 Reference Manual --
74 ------------------------------------------------------
134 -------------------------------------------------
135 -- RM Required Additions to Ada for GNAT Types --
136 -------------------------------------------------
138 -- Note: Long versions are considered RM defined, but not the Long Long,
139 -- Short, or Short_Short versions.
165 -----------------------------------
166 -- GNAT Defined Additions to Ada --
167 -----------------------------------
187 -- Note: strictly the next two should be Ada 2005 units, but it seems
188 -- harmless (and useful) to make then available in Ada 95 mode, since
189 -- they only deal with Wide_Character, not Wide_Wide_Character.
194 -- Note: strictly the following should be Ada 2012 units, but it seems
195 -- harmless (and useful) to make then available in Ada 95 mode, since
196 -- they do not deal with Wide_Wide_Character.
204 ---------------------------
205 -- GNAT Special IO Units --
206 ---------------------------
208 -- As further explained elsewhere (see Sem_Ch10), the internal packages of
209 -- Text_IO and Wide_Text_IO are actually implemented as separate children,
210 -- but this fact is intended to be hidden from the user completely. Any
211 -- attempt to WITH one of these units will be diagnosed as an error later
212 -- on, but for now we do not consider these internal implementation units
213 -- (if we did, then we would get a junk warning which would be confusing
214 -- and unnecessary, given that we generate a clear error message).
230 ------------------------
231 -- GNAT Library Units --
232 ------------------------
331 -----------------------------------------------------
332 -- Interface Hierarchy Units from Reference Manual --
333 -----------------------------------------------------
341 ------------------------------------------
342 -- GNAT Defined Additions to Interfaces --
343 ------------------------------------------
355 --------------------------------------------------
356 -- System Hierarchy Units from Reference Manual --
357 --------------------------------------------------
365 --------------------------------------
366 -- GNAT Defined Additions to System --
367 --------------------------------------
389 -- The following are strictly speaking Ada 2012 units, but we are allowed
390 -- to add children to system, so we consider them to be implementation
391 -- defined additions to System in earlier versions of Ada.
396 --------------------
397 -- Ada 2005 Units --
398 --------------------
400 -- The following units should be used only in Ada 05 mode
404 --------------------------------------------------------
405 -- Ada Hierarchy Units from Ada 2005 Reference Manual --
406 --------------------------------------------------------
476 ------------------------------------------------------
477 -- RM Required Additions to Ada 2005 for GNAT Types --
478 ------------------------------------------------------
480 -- Note: Long versions are considered RM defined, but not the Long Long,
481 -- Short, or Short_Short versions.
498 ----------------------------------------
499 -- GNAT Defined Additions to Ada 2005 --
500 ----------------------------------------
512 -- Note: strictly the following should be Ada 2012 units, but it seems
513 -- harmless (and useful) to make then available in Ada 2005 mode.
530 ---------------------------
531 -- GNAT Special IO Units --
532 ---------------------------
534 -- See Ada 95 section for further information. These packages are for the
535 -- implementation of the Wide_Wide_Text_IO generic packages.
544 ------------------------
545 -- GNAT Library Units --
546 ------------------------
551 --------------------
552 -- Ada 2012 Units --
553 --------------------
555 -- The following units should be used only in Ada 2012 mode
580 ----------------------------------------
581 -- GNAT Defined Additions to Ada 2012 --
582 ----------------------------------------
593 -----------------------
594 -- Alternative Units --
595 -----------------------
597 -- For some implementation units, there is a unit in the GNAT library
598 -- that has identical functionality that is usable. If we have such a
599 -- case we record the appropriate Unit name in Error_Msg_String.
606 -- Array of alternative unit names
619 -- Array giving mapping
624 ("htable", Shtable'Access),
625 ("os_lib", Sos_lib'Access),
626 ("regexp", Sregexp'Access),
627 ("regpat", Sregpat'Access),
628 ("string", Sstring'Access),
629 ("stusta", Sstusta'Access),
630 ("tasloc", Stasloc'Access),
631 ("utf_32", Sutf_32'Access));
633 ----------------------
634 -- Get_Kind_Of_Unit --
635 ----------------------
637 function Get_Kind_Of_Unit (U : Unit_Number_Type) return Kind_Of_Unit is
638 Fname : constant File_Name_Type := Unit_File_Name (U);
640 begin
641 Error_Msg_Strlen := 0;
642 Get_Name_String (Fname);
644 -- Ada/System/Interfaces are all Ada 95 units
646 if (Name_Len = 7 and then Name_Buffer (1 .. 7) = "ada.ads")
647 or else
648 (Name_Len = 10 and then Name_Buffer (1 .. 10) = "system.ads")
649 or else
650 (Name_Len = 12 and then Name_Buffer (1 .. 12) = "interfac.ads")
651 then
652 return Ada_95_Unit;
653 end if;
655 -- If length of file name is greater than 12, not predefined. The value
656 -- 12 here is an 8 char name with extension .ads.
658 if Name_Len > 12 then
659 return Not_Predefined_Unit;
660 end if;
662 -- Not predefined if file name does not start with a- g- s- i-
664 if Name_Len < 3
667 and then
669 and then
671 and then
673 then
674 return Not_Predefined_Unit;
675 end if;
677 -- To be considered predefined, the file name must end in .ads or .adb.
678 -- File names with other extensions (coming from the use of non-standard
679 -- file naming schemes) can never be predefined.
681 -- Note that in the context of a compiler, the .adb case will never
682 -- arise. However it can arise for other tools, e.g. gnatprove uses
683 -- this routine to detect when a construct comes from an instance of
684 -- a generic defined in a predefined unit.
686 if Name_Buffer (Name_Len - 3 .. Name_Len) /= ".ads"
687 and then
688 Name_Buffer (Name_Len - 3 .. Name_Len) /= ".adb"
689 then
690 return Not_Predefined_Unit;
691 end if;
693 -- Otherwise normalize file name to 8 characters
695 Name_Len := Name_Len - 4;
696 while Name_Len < 8 loop
697 Name_Len := Name_Len + 1;
699 end loop;
701 -- See if name is in 95 list
703 for J in Non_Imp_File_Names_95'Range loop
704 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_95 (J).Fname then
705 return Ada_95_Unit;
706 end if;
707 end loop;
709 -- See if name is in 2005 list
711 for J in Non_Imp_File_Names_05'Range loop
712 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_05 (J).Fname then
713 return Ada_2005_Unit;
714 end if;
715 end loop;
717 -- See if name is in 2012 list
719 for J in Non_Imp_File_Names_12'Range loop
720 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_12 (J).Fname then
721 return Ada_2012_Unit;
722 end if;
723 end loop;
725 -- Only remaining special possibilities are children of System.RPC and
726 -- System.Garlic and special files of the form System.Aux...
728 Get_Name_String (Unit_Name (U));
730 if Name_Len > 12
731 and then Name_Buffer (1 .. 11) = "system.rpc."
732 then
733 return Ada_95_Unit;
734 end if;
736 if Name_Len > 15
737 and then Name_Buffer (1 .. 14) = "system.garlic."
738 then
739 return Ada_95_Unit;
740 end if;
742 if Name_Len > 11
743 and then Name_Buffer (1 .. 10) = "system.aux"
744 then
745 return Ada_95_Unit;
746 end if;
748 -- All tests failed, this is definitely an implementation unit. See if
749 -- we have an alternative name.
751 Get_Name_String (Fname);
753 if Name_Len in 11 .. 12
754 and then Name_Buffer (1 .. 2) = "s-"
755 and then Name_Buffer (Name_Len - 3 .. Name_Len) = ".ads"
756 then
757 for J in Map_Array'Range loop
758 if (Name_Len = 12 and then
759 Name_Buffer (3 .. 8) = Map_Array (J).Fname)
760 or else
761 (Name_Len = 11 and then
762 Name_Buffer (3 .. 7) = Map_Array (J).Fname (1 .. 5))
763 then
764 Error_Msg_Strlen := Map_Array (J).Aname'Length;
765 Error_Msg_String (1 .. Error_Msg_Strlen) :=
766 Map_Array (J).Aname.all;
767 end if;
768 end loop;
769 end if;
771 return Implementation_Unit;
772 end Get_Kind_Of_Unit;
774 -------------------
775 -- Is_Known_Unit --
776 -------------------
778 function Is_Known_Unit (Nam : Node_Id) return Boolean is
779 Unam : Unit_Name_Type;
780 Fnam : File_Name_Type;
782 begin
783 -- If selector is not an identifier (e.g. it is a character literal or
784 -- some junk from a previous error), then definitely not a known unit.
786 if Nkind (Selector_Name (Nam)) /= N_Identifier then
787 return False;
788 end if;
790 -- Otherwise get corresponding file name
792 Unam := Get_Unit_Name (Nam);
793 Fnam := Get_File_Name (Unam, Subunit => False);
794 Get_Name_String (Fnam);
796 Error_Msg_Strlen := 0;
798 -- Ada/System/Interfaces are all Ada 95 units
800 if (Name_Len = 7 and then Name_Buffer (1 .. 7) = "ada.ads")
801 or else
802 (Name_Len = 10 and then Name_Buffer (1 .. 10) = "system.ads")
803 or else
804 (Name_Len = 12 and then Name_Buffer (1 .. 12) = "interfac.ads")
805 then
806 return True;
807 end if;
809 -- Remove extension from file name
811 if Name_Buffer (Name_Len - 3 .. Name_Len) = ".adb"
812 or else
813 Name_Buffer (Name_Len - 3 .. Name_Len) = ".ads"
814 then
815 Name_Len := Name_Len - 4;
816 else
817 return False;
818 end if;
820 -- Pad name to 8 characters
822 while Name_Len < 8 loop
823 Name_Len := Name_Len + 1;
825 end loop;
827 -- If length more than 8, definitely not a match
829 if Name_Len /= 8 then
830 return False;
831 end if;
833 -- If length is 8, search our tables
835 for J in Non_Imp_File_Names_95'Range loop
836 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_95 (J).Fname then
837 return True;
838 end if;
839 end loop;
841 for J in Non_Imp_File_Names_05'Range loop
842 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_05 (J).Fname then
843 return True;
844 end if;
845 end loop;
847 for J in Non_Imp_File_Names_12'Range loop
848 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_12 (J).Fname then
849 return True;
850 end if;
851 end loop;
853 -- If not found, not known
855 return False;
857 -- A safety guard, if we get an exception during this processing then it
858 -- is most likely the result of a previous error, or a peculiar case we
859 -- have not thought of. Since this routine is only used for error message
860 -- refinement, we will just return False.
862 exception
863 when others =>
864 return False;
865 end Is_Known_Unit;
867 ---------------------------
868 -- Not_Impl_Defined_Unit --
869 ---------------------------
871 function Not_Impl_Defined_Unit (U : Unit_Number_Type) return Boolean is
872 Fname : constant File_Name_Type := Unit_File_Name (U);
874 begin
875 Error_Msg_Strlen := 0;
876 Get_Name_String (Fname);
878 -- Ada/System/Interfaces are all RM-defined Ada 95 units
880 if (Name_Len = 7 and then Name_Buffer (1 .. 7) = "ada.ads")
881 or else
882 (Name_Len = 10 and then Name_Buffer (1 .. 10) = "system.ads")
883 or else
884 (Name_Len = 12 and then Name_Buffer (1 .. 12) = "interfac.ads")
885 then
886 return True;
887 end if;
889 -- If length of file name is greater than 12, then it's a user unit
890 -- and not a GNAT implementation defined unit.
892 if Name_Len > 12 then
893 return True;
894 end if;
896 -- Implementation defined if unit in the gnat hierarchy
898 if (Name_Len = 8 and then Name_Buffer (1 .. 8) = "gnat.ads")
899 or else (Name_Len > 2 and then Name_Buffer (1 .. 2) = "g-")
900 then
901 return False;
902 end if;
904 -- Not implementation defined if file name does not start with a- s- i-
906 if Name_Len < 3
909 and then
911 and then
913 then
914 return True;
915 end if;
917 -- Not impl-defined if file name does not end in .ads. This can happen
918 -- when non-standard file names are being used.
920 if Name_Buffer (Name_Len - 3 .. Name_Len) /= ".ads" then
921 return True;
922 end if;
924 -- Otherwise normalize file name to 8 characters
926 Name_Len := Name_Len - 4;
927 while Name_Len < 8 loop
928 Name_Len := Name_Len + 1;
930 end loop;
932 -- Check our lists of names, if we find a match, return corresponding
933 -- indication of whether the file is RM defined, respecting the RM
934 -- version in which it is defined.
936 for J in Non_Imp_File_Names_95'Range loop
937 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_95 (J).Fname then
938 return Non_Imp_File_Names_95 (J).RMdef;
939 end if;
940 end loop;
942 for J in Non_Imp_File_Names_05'Range loop
943 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_05 (J).Fname then
944 return Non_Imp_File_Names_05 (J).RMdef
945 and then Ada_Version >= Ada_2005;
946 end if;
947 end loop;
949 for J in Non_Imp_File_Names_12'Range loop
950 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_12 (J).Fname then
951 return Non_Imp_File_Names_95 (J).RMdef
952 and then Ada_Version >= Ada_2012;
953 end if;
954 end loop;
956 -- If unit is in System, Ada or Interfaces hierarchies and did not match
957 -- any entry in the list, means it is an internal implementation defined
958 -- unit which the restriction should definition forbid.
960 return True;
961 end Not_Impl_Defined_Unit;
963 end Impunit;