| blob | fe89924333e281593c7bcfb77127cf39a5fbff4e |
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.
185 ---------------------------
186 -- GNAT Special IO Units --
187 ---------------------------
189 -- As further explained elsewhere (see Sem_Ch10), the internal packages of
190 -- Text_IO and Wide_Text_IO are actually implemented as separate children,
191 -- but this fact is intended to be hidden from the user completely. Any
192 -- attempt to WITH one of these units will be diagnosed as an error later
193 -- on, but for now we do not consider these internal implementation units
194 -- (if we did, then we would get a junk warning which would be confusing
195 -- and unnecessary, given that we generate a clear error message).
211 ------------------------
212 -- GNAT Library Units --
213 ------------------------
306 -----------------------------------------------------
307 -- Interface Hierarchy Units from Reference Manual --
308 -----------------------------------------------------
316 ------------------------------------------
317 -- GNAT Defined Additions to Interfaces --
318 ------------------------------------------
331 --------------------------------------------------
332 -- System Hierarchy Units from Reference Manual --
333 --------------------------------------------------
341 --------------------------------------
342 -- GNAT Defined Additions to System --
343 --------------------------------------
358 --------------------
359 -- Ada 2005 Units --
360 --------------------
362 -- The following units should be used only in Ada 05 mode
366 --------------------------------------------------------
367 -- Ada Hierarchy Units from Ada 2005 Reference Manual --
368 --------------------------------------------------------
436 ------------------------------------------------------
437 -- RM Required Additions to Ada 2005 for GNAT Types --
438 ------------------------------------------------------
456 ----------------------------------------
457 -- GNAT Defined Additions to Ada 2005 --
458 ----------------------------------------
472 -- Note: strictly the following should be Ada 2012 units, but it seems
473 -- harmless (and useful) to make then available in Ada 2005 mode.
477 ---------------------------
478 -- GNAT Special IO Units --
479 ---------------------------
481 -- See Ada 95 section for further information. These packages are for the
482 -- implementation of the Wide_Wide_Text_IO generic packages.
491 ------------------------
492 -- GNAT Library Units --
493 ------------------------
498 -----------------------
499 -- Alternative Units --
500 -----------------------
502 -- For some implementation units, there is a unit in the GNAT library
503 -- that has identical functionality that is usable. If we have such a
504 -- case we record the appropriate Unit name in Error_Msg_String.
511 -- Array of alternative unit names
524 -- Array giving mapping
529 ("htable", Shtable'Access),
530 ("os_lib", Sos_lib'Access),
531 ("regexp", Sregexp'Access),
532 ("regpat", Sregpat'Access),
533 ("string", Sstring'Access),
534 ("stusta", Sstusta'Access),
535 ("tasloc", Stasloc'Access),
536 ("utf_32", Sutf_32'Access));
538 ----------------------
539 -- Get_Kind_Of_Unit --
540 ----------------------
542 function Get_Kind_Of_Unit (U : Unit_Number_Type) return Kind_Of_Unit is
543 Fname : constant File_Name_Type := Unit_File_Name (U);
545 begin
546 Error_Msg_Strlen := 0;
548 -- If length of file name is greater than 12, not predefined.
549 -- The value 12 here is an 8 char name with extension .ads.
551 if Length_Of_Name (Fname) > 12 then
552 return Not_Predefined_Unit;
553 end if;
555 -- Otherwise test file name
557 Get_Name_String (Fname);
559 -- Not predefined if file name does not start with a- g- s- i-
561 if Name_Len < 3
564 and then
566 and then
568 and then
570 then
571 return Not_Predefined_Unit;
572 end if;
574 -- Not predefined if file name does not end in .ads. This can
575 -- happen when non-standard file names are being used.
577 if Name_Buffer (Name_Len - 3 .. Name_Len) /= ".ads" then
578 return Not_Predefined_Unit;
579 end if;
581 -- Otherwise normalize file name to 8 characters
583 Name_Len := Name_Len - 4;
584 while Name_Len < 8 loop
585 Name_Len := Name_Len + 1;
587 end loop;
589 -- See if name is in 95 list
591 for J in Non_Imp_File_Names_95'Range loop
592 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_95 (J) then
593 return Ada_95_Unit;
594 end if;
595 end loop;
597 -- See if name is in 05 list
599 for J in Non_Imp_File_Names_05'Range loop
600 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_05 (J) then
601 return Ada_05_Unit;
602 end if;
603 end loop;
605 -- Only remaining special possibilities are children of System.RPC and
606 -- System.Garlic and special files of the form System.Aux...
608 Get_Name_String (Unit_Name (U));
610 if Name_Len > 12
611 and then Name_Buffer (1 .. 11) = "system.rpc."
612 then
613 return Ada_95_Unit;
614 end if;
616 if Name_Len > 15
617 and then Name_Buffer (1 .. 14) = "system.garlic."
618 then
619 return Ada_95_Unit;
620 end if;
622 if Name_Len > 11
623 and then Name_Buffer (1 .. 10) = "system.aux"
624 then
625 return Ada_95_Unit;
626 end if;
628 -- All tests failed, this is definitely an implementation unit. See if
629 -- we have an alternative name.
631 Get_Name_String (Fname);
633 if Name_Len in 11 .. 12
634 and then Name_Buffer (1 .. 2) = "s-"
635 and then Name_Buffer (Name_Len - 3 .. Name_Len) = ".ads"
636 then
637 for J in Map_Array'Range loop
638 if (Name_Len = 12 and then
639 Name_Buffer (3 .. 8) = Map_Array (J).Fname)
640 or else
641 (Name_Len = 11 and then
642 Name_Buffer (3 .. 7) = Map_Array (J).Fname (1 .. 5))
643 then
644 Error_Msg_Strlen := Map_Array (J).Aname'Length;
645 Error_Msg_String (1 .. Error_Msg_Strlen) :=
646 Map_Array (J).Aname.all;
647 end if;
648 end loop;
649 end if;
651 return Implementation_Unit;
652 end Get_Kind_Of_Unit;
654 -------------------
655 -- Is_Known_Unit --
656 -------------------
658 function Is_Known_Unit (Nam : Node_Id) return Boolean is
659 Unam : Unit_Name_Type;
660 Fnam : File_Name_Type;
662 begin
663 -- If selector is not an identifier (e.g. it is a character literal or
664 -- some junk from a previous error), then definitely not a known unit.
666 if Nkind (Selector_Name (Nam)) /= N_Identifier then
667 return False;
668 end if;
670 -- Otherwise get corresponding file name
672 Unam := Get_Unit_Name (Nam);
673 Fnam := Get_File_Name (Unam, Subunit => False);
674 Get_Name_String (Fnam);
676 -- Remove extension from file name
678 if Name_Buffer (Name_Len - 3 .. Name_Len) = ".adb" then
679 Name_Len := Name_Len - 4;
680 else
681 return False;
682 end if;
684 -- Pad name to 8 characters
686 while Name_Len < 8 loop
687 Name_Len := Name_Len + 1;
689 end loop;
691 -- If length more than 8, definitely not a match
693 if Name_Len /= 8 then
694 return False;
695 end if;
697 -- If length is 8, search our tables
699 for J in Non_Imp_File_Names_95'Range loop
700 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_95 (J) then
701 return True;
702 end if;
703 end loop;
705 for J in Non_Imp_File_Names_05'Range loop
706 if Name_Buffer (1 .. 8) = Non_Imp_File_Names_05 (J) then
707 return True;
708 end if;
709 end loop;
711 -- If not found, not known
713 return False;
715 -- A safety guard, if we get an exception during this processing then it
716 -- is most likely the result of a previous error, or a peculiar case we
717 -- have not thought of. Since this routine is only used for error message
718 -- refinement, we will just return False.
720 exception
721 when others =>
722 return False;
723 end Is_Known_Unit;
725 end Impunit;