Skip to content

R
riscv-gcc-1
Commit 4c484f40 by Arnaud Charlet
Options

[multiple changes] 

2010-06-22  Thomas Quinot  <quinot@adacore.com>

	* sem_elab.adb: Minor reformatting.

2010-06-22  Vincent Celier  <celier@adacore.com>

	* gnatsym.adb: Put the object files in the table in increasing
	aphabetical order of base names.

2010-06-22  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Set_Entity_Or_Discriminal): New procedure used by
	Find_Direct_Name and Find_Expanded_Name, to replace a discriminant with
	the corresponding discriminal within a record declaration.

From-SVN: r161196
parent 61441c18
Showing with 113 additions and 68 deletions
gcc/ada/ChangeLog
2010-06-22 Thomas Quinot <quinot@adacore.com>
* sem_elab.adb: Minor reformatting.
2010-06-22 Vincent Celier <celier@adacore.com>
* gnatsym.adb: Put the object files in the table in increasing
aphabetical order of base names.
2010-06-22 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Set_Entity_Or_Discriminal): New procedure used by
Find_Direct_Name and Find_Expanded_Name, to replace a discriminant with
the corresponding discriminal within a record declaration.
2010-06-22 Thomas Quinot <quinot@adacore.com>
* exp_aggr.adb (Rewrite_Discriminant): Rewriting must occur only for an
expression referring to a discriminal of the type of the aggregate (not
a discriminal of some other unrelated type), and the prefix in the
......
gcc/ada/gnatsym.adb
......@@ -41,19 +41,19 @@
-- - (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 := "";
......@@ -82,8 +82,13 @@ procedure Gnatsym is
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,
......@@ -164,7 +169,8 @@ procedure Gnatsym is
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
......@@ -175,7 +181,26 @@ procedure Gnatsym is
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
......@@ -304,11 +329,13 @@ begin
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
......
gcc/ada/sem_ch8.adb
......@@ -407,6 +407,12 @@ package body Sem_Ch8 is
-- 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
......@@ -3036,6 +3042,56 @@ package body Sem_Ch8 is
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 --
-----------------------------------
......@@ -4498,58 +4554,7 @@ package body Sem_Ch8 is
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;
......@@ -4945,7 +4950,7 @@ package body Sem_Ch8 is
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;
......
gcc/ada/sem_elab.adb
......@@ -599,9 +599,7 @@ package body Sem_Elab is
-- No checks needed for pure or preelaborated compilation units
if Is_Pure (E_Scope)
or else Is_Preelaborated (E_Scope)
then
if Is_Pure (E_Scope) or else Is_Preelaborated (E_Scope) then
return;
end if;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment