| blob | e1cce657420c45b7c8b5bd588e36e87936a3a17a |
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-2016, 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 ------------------------
333 -----------------------------------------------------
334 -- Interface Hierarchy Units from Reference Manual --
335 -----------------------------------------------------
343 ------------------------------------------
344 -- GNAT Defined Additions to Interfaces --
345 ------------------------------------------
358 --------------------------------------------------
359 -- System Hierarchy Units from Reference Manual --
360 --------------------------------------------------
368 --------------------------------------
369 -- GNAT Defined Additions to System --
370 --------------------------------------
392 -- The following are strictly speaking Ada 2012 units, but we are allowed
393 -- to add children to system, so we consider them to be implementation
394 -- defined additions to System in earlier versions of Ada.
399 --------------------
400 -- Ada 2005 Units --
401 --------------------
403 -- The following units should be used only in Ada 05 mode
407 --------------------------------------------------------
408 -- Ada Hierarchy Units from Ada 2005 Reference Manual --
409 --------------------------------------------------------
480 ------------------------------------------------------
481 -- RM Required Additions to Ada 2005 for GNAT Types --
482 ------------------------------------------------------
484 -- Note: Long versions are considered RM defined, but not the Long Long,
485 -- Short, or Short_Short versions.
502 ----------------------------------------
503 -- GNAT Defined Additions to Ada 2005 --
504 ----------------------------------------
516 -- Note: strictly the following should be Ada 2012 units, but it seems
517 -- harmless (and useful) to make then available in Ada 2005 mode.
535 ---------------------------
536 -- GNAT Special IO Units --
537 ---------------------------
539 -- See Ada 95 section for further information. These packages are for the
540 -- implementation of the Wide_Wide_Text_IO generic packages.
549 ------------------------
550 -- GNAT Library Units --
551 ------------------------
556 --------------------
557 -- Ada 2012 Units --
558 --------------------
560 -- The following units should be used only in Ada 2012 mode
586 ----------------------------------------
587 -- GNAT Defined Additions to Ada 2012 --
588 ----------------------------------------
599 -----------------------
600 -- Alternative Units --
601 -----------------------
603 -- For some implementation units, there is a unit in the GNAT library
604 -- that has identical functionality that is usable. If we have such a
605 -- case we record the appropriate Unit name in Error_Msg_String.
612 -- Array of alternative unit names
625 -- Array giving mapping
630 ("htable", Shtable'Access),
631 ("os_lib", Sos_lib'Access),
632 ("regexp", Sregexp'Access),
633 ("regpat", Sregpat'Access),
634 ("string", Sstring'Access),
635 ("stusta", Sstusta'Access),
636 ("tasloc", Stasloc'Access),
637 ("utf_32", Sutf_32'Access));
639 ----------------------
640 -- Get_Kind_Of_File --
641 ----------------------
643 function Get_Kind_Of_File (File : String) return Kind_Of_Unit is
644 pragma Assert (File'First = 1);
646 Buffer : String (1 .. 8);
648 begin
649 Error_Msg_Strlen := 0;
651 -- Ada/System/Interfaces are all Ada 95 units
653 if File = "ada.ads"
654 or else File = "interfac.ads"
655 or else File = "system.ads"
656 then
657 return Ada_95_Unit;
658 end if;
660 -- If length of file name is greater than 12, not predefined. The value
661 -- 12 here is an 8 char name with extension .ads.
663 if File'Length > 12 then
664 return Not_Predefined_Unit;
665 end if;
667 -- Not predefined if file name does not start with a- g- s- i-
669 if File'Length < 3
671 or else
676 then
677 return Not_Predefined_Unit;
678 end if;
680 -- To be considered predefined, the file name must end in .ads or .adb.
681 -- File names with other extensions (coming from the use of non-standard
682 -- file naming schemes) can never be predefined.
684 -- Note that in the context of a compiler, the .adb case will never
685 -- arise. However it can arise for other tools, e.g. gnatprove uses
686 -- this routine to detect when a construct comes from an instance of
687 -- a generic defined in a predefined unit.
689 if File (File'Last - 3 .. File'Last) /= ".ads"
690 and then
691 File (File'Last - 3 .. File'Last) /= ".adb"
692 then
693 return Not_Predefined_Unit;
694 end if;
696 -- Otherwise normalize file name to 8 characters
698 Buffer (1 .. File'Length - 4) := File (1 .. File'Length - 4);
700 for J in File'Length - 3 .. 8 loop
702 end loop;
704 -- See if name is in 95 list
706 for J in Non_Imp_File_Names_95'Range loop
707 if Buffer = Non_Imp_File_Names_95 (J).Fname then
708 return Ada_95_Unit;
709 end if;
710 end loop;
712 -- See if name is in 2005 list
714 for J in Non_Imp_File_Names_05'Range loop
715 if Buffer = Non_Imp_File_Names_05 (J).Fname then
716 return Ada_2005_Unit;
717 end if;
718 end loop;
720 -- See if name is in 2012 list
722 for J in Non_Imp_File_Names_12'Range loop
723 if Buffer = Non_Imp_File_Names_12 (J).Fname then
724 return Ada_2012_Unit;
725 end if;
726 end loop;
728 -- Only remaining special possibilities are children of System.RPC and
729 -- System.Garlic and special files of the form System.Aux...
731 if File (1 .. 5) = "s-aux"
732 or else File (1 .. 5) = "s-gar"
733 or else File (1 .. 5) = "s-rpc"
734 then
735 return Ada_95_Unit;
736 end if;
738 -- All tests failed, this is definitely an implementation unit. See if
739 -- we have an alternative name.
741 if File'Length in 11 .. 12
742 and then File (1 .. 2) = "s-"
743 and then File (File'Last - 3 .. File'Last) = ".ads"
744 then
745 for J in Map_Array'Range loop
746 if (File'Length = 12 and then
747 File (3 .. 8) = Map_Array (J).Fname)
748 or else
749 (File'Length = 11 and then
750 File (3 .. 7) = Map_Array (J).Fname (1 .. 5))
751 then
752 Error_Msg_Strlen := Map_Array (J).Aname'Length;
753 Error_Msg_String (1 .. Error_Msg_Strlen) :=
754 Map_Array (J).Aname.all;
755 end if;
756 end loop;
757 end if;
759 return Implementation_Unit;
760 end Get_Kind_Of_File;
762 ----------------------
763 -- Get_Kind_Of_Unit --
764 ----------------------
766 function Get_Kind_Of_Unit (U : Unit_Number_Type) return Kind_Of_Unit is
767 begin
768 Get_Name_String (Unit_File_Name (U));
769 return Get_Kind_Of_File (Name_Buffer (1 .. Name_Len));
770 end Get_Kind_Of_Unit;
772 -------------------
773 -- Is_Known_Unit --
774 -------------------
776 function Is_Known_Unit (Nam : Node_Id) return Boolean is
777 Unam : Unit_Name_Type;
778 Fnam : File_Name_Type;
780 begin
781 -- If selector is not an identifier (e.g. it is a character literal or
782 -- some junk from a previous error), then definitely not a known unit.
784 if Nkind (Selector_Name (Nam)) /= N_Identifier then
785 return False;
786 end if;
788 -- Otherwise get corresponding file name
790 Unam := Get_Unit_Name (Nam);
791 Fnam := Get_File_Name (Unam, Subunit => False);
792 Get_Name_String (Fnam);
794 Error_Msg_Strlen := 0;
796 -- Ada/System/Interfaces are all Ada 95 units
798 if (Name_Len = 7 and then Name_Buffer (1 .. 7) = "ada.ads")
799 or else
800 (Name_Len = 10 and then Name_Buffer (1 .. 10) = "system.ads")
801 or else
802 (Name_Len = 12 and then Name_Buffer (1 .. 12) = "interfac.ads")
803 then
804 return True;
805 end if;
807 -- Remove extension from file name
809 if Name_Buffer (Name_Len - 3 .. Name_Len) = ".adb"
810 or else
811 Name_Buffer (Name_Len - 3 .. Name_Len) = ".ads"
812 then
813 Name_Len := Name_Len - 4;
814 else
815 return False;
816 end if;
818 -- Pad name to 8 characters
820 while Name_Len < 8 loop
821 Name_Len := Name_Len + 1;
823 end loop;
825 -- If length more than 8, definitely not a match
827 if Name_Len /= 8 then
828 return False;
829 end if;
831 -- If length is 8, search our tables
833 for J in Non_Imp_File_Names_95'Range loop
834 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_95 (J).Fname then
835 return True;
836 end if;
837 end loop;
839 for J in Non_Imp_File_Names_05'Range loop
840 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_05 (J).Fname then
841 return True;
842 end if;
843 end loop;
845 for J in Non_Imp_File_Names_12'Range loop
846 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_12 (J).Fname then
847 return True;
848 end if;
849 end loop;
851 -- If not found, not known
853 return False;
855 -- A safety guard, if we get an exception during this processing then it
856 -- is most likely the result of a previous error, or a peculiar case we
857 -- have not thought of. Since this routine is only used for error message
858 -- refinement, we will just return False.
860 exception
861 when others =>
862 return False;
863 end Is_Known_Unit;
865 ---------------------------
866 -- Not_Impl_Defined_Unit --
867 ---------------------------
869 function Not_Impl_Defined_Unit (U : Unit_Number_Type) return Boolean is
870 Fname : constant File_Name_Type := Unit_File_Name (U);
872 begin
873 Error_Msg_Strlen := 0;
874 Get_Name_String (Fname);
876 -- Ada/System/Interfaces are all RM-defined Ada 95 units
878 if (Name_Len = 7 and then Name_Buffer (1 .. 7) = "ada.ads")
879 or else
880 (Name_Len = 10 and then Name_Buffer (1 .. 10) = "system.ads")
881 or else
882 (Name_Len = 12 and then Name_Buffer (1 .. 12) = "interfac.ads")
883 then
884 return True;
885 end if;
887 -- If length of file name is greater than 12, then it's a user unit
888 -- and not a GNAT implementation defined unit.
890 if Name_Len > 12 then
891 return True;
892 end if;
894 -- Implementation defined if unit in the gnat hierarchy
896 if (Name_Len = 8 and then Name_Buffer (1 .. 8) = "gnat.ads")
897 or else (Name_Len > 2 and then Name_Buffer (1 .. 2) = "g-")
898 then
899 return False;
900 end if;
902 -- Not implementation defined if file name does not start with a- s- i-
904 if Name_Len < 3
907 and then
909 and then
911 then
912 return True;
913 end if;
915 -- Not impl-defined if file name does not end in .ads. This can happen
916 -- when non-standard file names are being used.
918 if Name_Buffer (Name_Len - 3 .. Name_Len) /= ".ads" then
919 return True;
920 end if;
922 -- Otherwise normalize file name to 8 characters
924 Name_Len := Name_Len - 4;
925 while Name_Len < 8 loop
926 Name_Len := Name_Len + 1;
928 end loop;
930 -- Check our lists of names, if we find a match, return corresponding
931 -- indication of whether the file is RM defined, respecting the RM
932 -- version in which it is defined.
934 for J in Non_Imp_File_Names_95'Range loop
935 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_95 (J).Fname then
936 return Non_Imp_File_Names_95 (J).RMdef;
937 end if;
938 end loop;
940 for J in Non_Imp_File_Names_05'Range loop
941 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_05 (J).Fname then
942 return Non_Imp_File_Names_05 (J).RMdef
943 and then Ada_Version >= Ada_2005;
944 end if;
945 end loop;
947 for J in Non_Imp_File_Names_12'Range loop
948 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_12 (J).Fname then
949 return Non_Imp_File_Names_95 (J).RMdef
950 and then Ada_Version >= Ada_2012;
951 end if;
952 end loop;
954 -- If unit is in System, Ada or Interfaces hierarchies and did not match
955 -- any entry in the list, means it is an internal implementation defined
956 -- unit which the restriction should definition forbid.
958 return True;
959 end Not_Impl_Defined_Unit;
961 end Impunit;