| blob | c53cdf986a85ded26022cbf1af7e5f6873a58a2c |
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-2019, 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 GNAT Studio and GNATBench to supply a
36 -- list of 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 ------------------------
337 -----------------------------------------------------
338 -- Interface Hierarchy Units from Reference Manual --
339 -----------------------------------------------------
347 ------------------------------------------
348 -- GNAT Defined Additions to Interfaces --
349 ------------------------------------------
362 --------------------------------------------------
363 -- System Hierarchy Units from Reference Manual --
364 --------------------------------------------------
372 --------------------------------------
373 -- GNAT Defined Additions to System --
374 --------------------------------------
404 -- The following are strictly speaking Ada 2012 units, but we are allowed
405 -- to add children to system, so we consider them to be implementation
406 -- defined additions to System in earlier versions of Ada.
411 --------------------
412 -- Ada 2005 Units --
413 --------------------
415 -- The following units should be used only in Ada 05 mode
419 --------------------------------------------------------
420 -- Ada Hierarchy Units from Ada 2005 Reference Manual --
421 --------------------------------------------------------
492 ------------------------------------------------------
493 -- RM Required Additions to Ada 2005 for GNAT Types --
494 ------------------------------------------------------
496 -- Note: Long versions are considered RM defined, but not the Long Long,
497 -- Short, or Short_Short versions.
514 ----------------------------------------
515 -- GNAT Defined Additions to Ada 2005 --
516 ----------------------------------------
528 -- Note: strictly the following should be Ada 2012 units, but it seems
529 -- harmless (and useful) to make then available in Ada 2005 mode.
547 ---------------------------
548 -- GNAT Special IO Units --
549 ---------------------------
551 -- See Ada 95 section for further information. These packages are for the
552 -- implementation of the Wide_Wide_Text_IO generic packages.
561 ------------------------
562 -- GNAT Library Units --
563 ------------------------
568 --------------------
569 -- Ada 2012 Units --
570 --------------------
572 -- The following units should be used only in Ada 2012 mode
598 ----------------------------------------
599 -- GNAT Defined Additions to Ada 2012 --
600 ----------------------------------------
616 --------------------
617 -- Ada 202X Units --
618 --------------------
620 -- The following units should be used only in Ada 202X mode
632 -----------------------
633 -- Alternative Units --
634 -----------------------
636 -- For some implementation units, there is a unit in the GNAT library
637 -- that has identical functionality that is usable. If we have such a
638 -- case we record the appropriate Unit name in Error_Msg_String.
645 -- Array of alternative unit names
658 -- Array giving mapping
663 ("htable", Shtable'Access),
664 ("os_lib", Sos_lib'Access),
665 ("regexp", Sregexp'Access),
666 ("regpat", Sregpat'Access),
667 ("string", Sstring'Access),
668 ("stusta", Sstusta'Access),
669 ("tasloc", Stasloc'Access),
670 ("utf_32", Sutf_32'Access));
672 ----------------------
673 -- Get_Kind_Of_File --
674 ----------------------
676 function Get_Kind_Of_File (File : String) return Kind_Of_Unit is
677 pragma Assert (File'First = 1);
679 Buffer : String (1 .. 8);
681 begin
682 Error_Msg_Strlen := 0;
684 -- Ada/System/Interfaces are all Ada 95 units
686 if File = "ada.ads"
687 or else File = "interfac.ads"
688 or else File = "system.ads"
689 then
690 return Ada_95_Unit;
691 end if;
693 -- If length of file name is greater than 12, not predefined. The value
694 -- 12 here is an 8 char name with extension .ads.
696 if File'Length > 12 then
697 return Not_Predefined_Unit;
698 end if;
700 -- Not predefined if file name does not start with a- g- s- i-
702 if File'Length < 3
704 or else
709 then
710 return Not_Predefined_Unit;
711 end if;
713 -- Not predefined if file name does not end in .ads. This can happen
714 -- when non-standard file names are being used.
716 if Name_Buffer (Name_Len - 3 .. Name_Len) /= ".ads" then
717 return Not_Predefined_Unit;
718 end if;
720 -- Otherwise normalize file name to 8 characters
722 Buffer (1 .. File'Length - 4) := File (1 .. File'Length - 4);
724 for J in File'Length - 3 .. 8 loop
726 end loop;
728 -- See if name is in 95 list
730 for J in Non_Imp_File_Names_95'Range loop
731 if Buffer = Non_Imp_File_Names_95 (J).Fname then
732 return Ada_95_Unit;
733 end if;
734 end loop;
736 -- See if name is in 2005 list
738 for J in Non_Imp_File_Names_05'Range loop
739 if Buffer = Non_Imp_File_Names_05 (J).Fname then
740 return Ada_2005_Unit;
741 end if;
742 end loop;
744 -- See if name is in 2012 list
746 for J in Non_Imp_File_Names_12'Range loop
747 if Buffer = Non_Imp_File_Names_12 (J).Fname then
748 return Ada_2012_Unit;
749 end if;
750 end loop;
752 -- See if name is in 202X list
754 for J in Non_Imp_File_Names_2X'Range loop
755 if Buffer = Non_Imp_File_Names_2X (J).Fname then
756 return Ada_202X_Unit;
757 end if;
758 end loop;
760 -- Only remaining special possibilities are children of System.RPC and
761 -- System.Garlic and special files of the form System.Aux...
763 if File (1 .. 5) = "s-aux"
764 or else File (1 .. 5) = "s-gar"
765 or else File (1 .. 5) = "s-rpc"
766 then
767 return Ada_95_Unit;
768 end if;
770 -- All tests failed, this is definitely an implementation unit. See if
771 -- we have an alternative name.
773 if File'Length in 11 .. 12
774 and then File (1 .. 2) = "s-"
775 and then File (File'Last - 3 .. File'Last) = ".ads"
776 then
777 for J in Map_Array'Range loop
778 if (File'Length = 12 and then
779 File (3 .. 8) = Map_Array (J).Fname)
780 or else
781 (File'Length = 11 and then
782 File (3 .. 7) = Map_Array (J).Fname (1 .. 5))
783 then
784 Error_Msg_Strlen := Map_Array (J).Aname'Length;
785 Error_Msg_String (1 .. Error_Msg_Strlen) :=
786 Map_Array (J).Aname.all;
787 end if;
788 end loop;
789 end if;
791 return Implementation_Unit;
792 end Get_Kind_Of_File;
794 ----------------------
795 -- Get_Kind_Of_Unit --
796 ----------------------
798 function Get_Kind_Of_Unit (U : Unit_Number_Type) return Kind_Of_Unit is
799 begin
800 Get_Name_String (Unit_File_Name (U));
801 return Get_Kind_Of_File (Name_Buffer (1 .. Name_Len));
802 end Get_Kind_Of_Unit;
804 -------------------
805 -- Is_Known_Unit --
806 -------------------
808 function Is_Known_Unit (Nam : Node_Id) return Boolean is
809 Unam : Unit_Name_Type;
810 Fnam : File_Name_Type;
812 begin
813 -- If selector is not an identifier (e.g. it is a character literal or
814 -- some junk from a previous error), then definitely not a known unit.
816 if Nkind (Selector_Name (Nam)) /= N_Identifier then
817 return False;
818 end if;
820 -- Otherwise get corresponding file name
822 Unam := Get_Unit_Name (Nam);
823 Fnam := Get_File_Name (Unam, Subunit => False);
824 Get_Name_String (Fnam);
826 Error_Msg_Strlen := 0;
828 -- Ada/System/Interfaces are all Ada 95 units
830 if (Name_Len = 7 and then Name_Buffer (1 .. 7) = "ada.ads")
831 or else
832 (Name_Len = 10 and then Name_Buffer (1 .. 10) = "system.ads")
833 or else
834 (Name_Len = 12 and then Name_Buffer (1 .. 12) = "interfac.ads")
835 then
836 return True;
837 end if;
839 -- Remove extension from file name
841 if Name_Buffer (Name_Len - 3 .. Name_Len) = ".adb"
842 or else
843 Name_Buffer (Name_Len - 3 .. Name_Len) = ".ads"
844 then
845 Name_Len := Name_Len - 4;
846 else
847 return False;
848 end if;
850 -- Pad name to 8 characters
852 while Name_Len < 8 loop
853 Name_Len := Name_Len + 1;
855 end loop;
857 -- If length more than 8, definitely not a match
859 if Name_Len /= 8 then
860 return False;
861 end if;
863 -- If length is 8, search our tables
865 for J in Non_Imp_File_Names_95'Range loop
866 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_95 (J).Fname then
867 return True;
868 end if;
869 end loop;
871 for J in Non_Imp_File_Names_05'Range loop
872 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_05 (J).Fname then
873 return True;
874 end if;
875 end loop;
877 for J in Non_Imp_File_Names_12'Range loop
878 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_12 (J).Fname then
879 return True;
880 end if;
881 end loop;
883 -- If not found, not known
885 return False;
887 -- A safety guard, if we get an exception during this processing then it
888 -- is most likely the result of a previous error, or a peculiar case we
889 -- have not thought of. Since this routine is only used for error message
890 -- refinement, we will just return False.
892 exception
893 when others =>
894 return False;
895 end Is_Known_Unit;
897 ---------------------------
898 -- Not_Impl_Defined_Unit --
899 ---------------------------
901 function Not_Impl_Defined_Unit (U : Unit_Number_Type) return Boolean is
902 Fname : constant File_Name_Type := Unit_File_Name (U);
904 begin
905 Error_Msg_Strlen := 0;
906 Get_Name_String (Fname);
908 -- Ada/System/Interfaces are all RM-defined Ada 95 units
910 if (Name_Len = 7 and then Name_Buffer (1 .. 7) = "ada.ads")
911 or else
912 (Name_Len = 10 and then Name_Buffer (1 .. 10) = "system.ads")
913 or else
914 (Name_Len = 12 and then Name_Buffer (1 .. 12) = "interfac.ads")
915 then
916 return True;
917 end if;
919 -- If length of file name is greater than 12, then it's a user unit
920 -- and not a GNAT implementation defined unit.
922 if Name_Len > 12 then
923 return True;
924 end if;
926 -- Implementation defined if unit in the gnat hierarchy
928 if (Name_Len = 8 and then Name_Buffer (1 .. 8) = "gnat.ads")
929 or else (Name_Len > 2 and then Name_Buffer (1 .. 2) = "g-")
930 then
931 return False;
932 end if;
934 -- Not implementation defined if file name does not start with a- s- i-
936 if Name_Len < 3
939 and then
941 and then
943 then
944 return True;
945 end if;
947 -- Not impl-defined if file name does not end in .ads. This can happen
948 -- when non-standard file names are being used.
950 if Name_Buffer (Name_Len - 3 .. Name_Len) /= ".ads" then
951 return True;
952 end if;
954 -- Otherwise normalize file name to 8 characters
956 Name_Len := Name_Len - 4;
957 while Name_Len < 8 loop
958 Name_Len := Name_Len + 1;
960 end loop;
962 -- Check our lists of names, if we find a match, return corresponding
963 -- indication of whether the file is RM defined, respecting the RM
964 -- version in which it is defined.
966 for J in Non_Imp_File_Names_95'Range loop
967 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_95 (J).Fname then
968 return Non_Imp_File_Names_95 (J).RMdef;
969 end if;
970 end loop;
972 for J in Non_Imp_File_Names_05'Range loop
973 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_05 (J).Fname then
974 return Non_Imp_File_Names_05 (J).RMdef
975 and then Ada_Version >= Ada_2005;
976 end if;
977 end loop;
979 for J in Non_Imp_File_Names_12'Range loop
980 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_12 (J).Fname then
981 return Non_Imp_File_Names_95 (J).RMdef
982 and then Ada_Version >= Ada_2012;
983 end if;
984 end loop;
986 -- If unit is in System, Ada or Interfaces hierarchies and did not match
987 -- any entry in the list, means it is an internal implementation defined
988 -- unit which the restriction should definition forbid.
990 return True;
991 end Not_Impl_Defined_Unit;
993 end Impunit;