-- - (optional) the name of the reference symbol file
-- - the names of one or more object files where the symbols are found
-with Ada.Exceptions; use Ada.Exceptions;
-with Ada.Text_IO; use Ada.Text_IO;
-
-with GNAT.Command_Line; use GNAT.Command_Line;
-with GNAT.OS_Lib; use GNAT.OS_Lib;
-
with Gnatvsn; use Gnatvsn;
with Osint; use Osint;
with Output; use Output;
-
with Symbols; use Symbols;
with Table;
+with Ada.Exceptions; use Ada.Exceptions;
+with Ada.Text_IO; use Ada.Text_IO;
+
+with GNAT.Command_Line; use GNAT.Command_Line;
+with GNAT.Directory_Operations; use GNAT.Directory_Operations;
+with GNAT.OS_Lib; use GNAT.OS_Lib;
+
procedure Gnatsym is
Empty_String : aliased String := "";
Version_String : String_Access := Empty;
-- The version of the library (used on VMS)
+ type Object_File_Data is record
+ Path : String_Access;
+ Name : String_Access;
+ end record;
+
package Object_Files is new Table.Table
- (Table_Component_Type => String_Access,
+ (Table_Component_Type => Object_File_Data,
Table_Index_Type => Natural,
Table_Low_Bound => 0,
Table_Initial => 10,
end case;
end loop;
- -- Get the file names
+ -- Get the object file names and put them in the table in alphabetical
+ -- order of base names.
loop
declare
exit when S'Length = 0;
Object_Files.Increment_Last;
- Object_Files.Table (Object_Files.Last) := S;
+
+ declare
+ Base : constant String := Base_Name (S.all);
+ Last : constant Positive := Object_Files.Last;
+ J : Positive;
+
+ begin
+ J := 1;
+ while J < Last loop
+ if Object_Files.Table (J).Name.all > Base then
+ Object_Files.Table (J + 1 .. Last) :=
+ Object_Files.Table (J .. Last - 1);
+ exit;
+ end if;
+
+ J := J + 1;
+ end loop;
+
+ Object_Files.Table (J) := (S, new String'(Base));
+ end;
end;
end loop;
exception
if Verbose then
Write_Str ("Processing object file """);
- Write_Str (Object_Files.Table (Object_File).all);
+ Write_Str (Object_Files.Table (Object_File).Path.all);
Write_Line ("""");
end if;
- Processing.Process (Object_Files.Table (Object_File).all, Success);
+ Processing.Process
+ (Object_Files.Table (Object_File).Path.all,
+ Success);
end loop;
-- Finalize the symbol file
-- is rewritten as a subprogram body that returns the attribute reference
-- applied to the formals of the function.
+ procedure Set_Entity_Or_Discriminal (N : Node_Id; E : Entity_Id);
+ -- Set Entity, with style check if need be. For a discriminant
+ -- reference, replace by the corresponding discriminal, i.e. the
+ -- parameter of the initialization procedure that corresponds to
+ -- the discriminant.
+
procedure Check_Frozen_Renaming (N : Node_Id; Subp : Entity_Id);
-- A renaming_as_body may occur after the entity of the original decla-
-- ration has been frozen. In that case, the body of the new entity must
end if;
end Check_Frozen_Renaming;
+ -------------------------------
+ -- Set_Entity_Or_Discriminal --
+ -------------------------------
+
+ procedure Set_Entity_Or_Discriminal (N : Node_Id; E : Entity_Id) is
+ P : Node_Id;
+
+ begin
+ -- If the entity is not a discriminant, or else expansion is disabled,
+ -- simply set the entity.
+
+ if not In_Spec_Expression
+ or else Ekind (E) /= E_Discriminant
+ or else Inside_A_Generic
+ then
+ Set_Entity_With_Style_Check (N, E);
+
+ -- The replacement of a discriminant by the corresponding discriminal
+ -- is not done for a task discriminant that appears in a default
+ -- expression of an entry parameter. See Expand_Discriminant in exp_ch2
+ -- for details on their handling.
+
+ elsif Is_Concurrent_Type (Scope (E)) then
+
+ P := Parent (N);
+ while Present (P)
+ and then not Nkind_In (P, N_Parameter_Specification,
+ N_Component_Declaration)
+ loop
+ P := Parent (P);
+ end loop;
+
+ if Present (P)
+ and then Nkind (P) = N_Parameter_Specification
+ then
+ null;
+
+ else
+ Set_Entity (N, Discriminal (E));
+ end if;
+
+ -- Otherwise, this is a discriminant in a context in which
+ -- it is a reference to the corresponding parameter of the
+ -- init proc for the enclosing type.
+
+ else
+ Set_Entity (N, Discriminal (E));
+ end if;
+ end Set_Entity_Or_Discriminal;
+
-----------------------------------
-- Check_In_Previous_With_Clause --
-----------------------------------
Check_Nested_Access (E);
end if;
- -- Set Entity, with style check if need be. For a discriminant
- -- reference, replace by the corresponding discriminal, i.e. the
- -- parameter of the initialization procedure that corresponds to
- -- the discriminant. If this replacement is being performed, there
- -- is no style check to perform.
-
- -- This replacement must not be done if we are currently
- -- processing a generic spec or body, because the discriminal
- -- has not been not generated in this case.
-
- -- The replacement is also skipped if we are in special
- -- spec-expression mode. Why is this skipped in this case ???
-
- if not In_Spec_Expression
- or else Ekind (E) /= E_Discriminant
- or else Inside_A_Generic
- then
- Set_Entity_With_Style_Check (N, E);
-
- -- The replacement is not done either for a task discriminant that
- -- appears in a default expression of an entry parameter. See
- -- Expand_Discriminant in exp_ch2 for details on their handling.
-
- elsif Is_Concurrent_Type (Scope (E)) then
- declare
- P : Node_Id;
-
- begin
- P := Parent (N);
- while Present (P)
- and then not Nkind_In (P, N_Parameter_Specification,
- N_Component_Declaration)
- loop
- P := Parent (P);
- end loop;
-
- if Present (P)
- and then Nkind (P) = N_Parameter_Specification
- then
- null;
- else
- Set_Entity (N, Discriminal (E));
- end if;
- end;
-
- -- Otherwise, this is a discriminant in a context in which
- -- it is a reference to the corresponding parameter of the
- -- init proc for the enclosing type.
-
- else
- Set_Entity (N, Discriminal (E));
- end if;
+ Set_Entity_Or_Discriminal (N, E);
end if;
end;
end Find_Direct_Name;
if Has_Homonym (Id) then
Set_Entity (N, Id);
else
- Set_Entity_With_Style_Check (N, Id);
+ Set_Entity_Or_Discriminal (N, Id);
Generate_Reference (Id, N);
end if;
projects / gcc.git / commitdiff