gcc:
[official-gcc.git] / gcc / ada / lib-list.adb
blob479a51e9791f81c3d7a705398e86c87f73881ad3
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- L I B . L I S T --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2005, 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 2, 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 COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
21 -- --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
28 -- --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
31 -- --
32 ------------------------------------------------------------------------------
34 separate (Lib)
35 procedure List (File_Names_Only : Boolean := False) is
37 Num_Units : constant Nat := Int (Units.Last) - Int (Units.First) + 1;
38 -- Number of units in file table
40 Sorted_Units : Unit_Ref_Table (1 .. Num_Units);
41 -- Table of unit numbers that we will sort
43 Unit_Hed : constant String := "Unit name ";
44 Unit_Und : constant String := "--------- ";
45 Unit_Bln : constant String := " ";
46 File_Hed : constant String := "File name ";
47 File_Und : constant String := "--------- ";
48 File_Bln : constant String := " ";
49 Time_Hed : constant String := "Time stamp";
50 Time_Und : constant String := "----------";
52 Unit_Length : constant Natural := Unit_Hed'Length;
53 File_Length : constant Natural := File_Hed'Length;
55 begin
56 -- First step is to make a sorted table of units
58 for J in 1 .. Num_Units loop
59 Sorted_Units (J) := Unit_Number_Type (Int (Units.First) + J - 1);
60 end loop;
62 Sort (Sorted_Units);
64 -- Now we can generate the unit table listing
66 Write_Eol;
68 if not File_Names_Only then
69 Write_Str (Unit_Hed);
70 Write_Str (File_Hed);
71 Write_Str (Time_Hed);
72 Write_Eol;
74 Write_Str (Unit_Und);
75 Write_Str (File_Und);
76 Write_Str (Time_Und);
77 Write_Eol;
78 Write_Eol;
79 end if;
81 for R in Sorted_Units'Range loop
82 if File_Names_Only then
83 if not Is_Internal_File_Name
84 (File_Name (Source_Index (Sorted_Units (R))))
85 then
86 Write_Name (Full_File_Name (Source_Index (Sorted_Units (R))));
87 Write_Eol;
88 end if;
90 else
91 Write_Unit_Name (Unit_Name (Sorted_Units (R)));
93 if Name_Len > (Unit_Length - 1) then
94 Write_Eol;
95 Write_Str (Unit_Bln);
96 else
97 for J in Name_Len + 1 .. Unit_Length loop
98 Write_Char (' ');
99 end loop;
100 end if;
102 Write_Name (Full_File_Name (Source_Index (Sorted_Units (R))));
104 if Name_Len > (File_Length - 1) then
105 Write_Eol;
106 Write_Str (Unit_Bln);
107 Write_Str (File_Bln);
108 else
109 for J in Name_Len + 1 .. File_Length loop
110 Write_Char (' ');
111 end loop;
112 end if;
114 Write_Str (String (Time_Stamp (Source_Index (Sorted_Units (R)))));
115 Write_Eol;
116 end if;
117 end loop;
119 Write_Eol;
120 end List;