mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-15 19:11:20 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2014-07-18  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Replace_Type_References_Generic): Use type entity
	as a parameter, rather than its Chars field, in order to locate
	freeze node of type. If the predicate or invariant has references
	to types other than the one to which the contract applies, these
	types must be frozen, and the corresponding predicate functions
	created, before that freeze node.

2014-07-18  Robert Dewar  <dewar@adacore.com>

	* freeze.adb, einfo.ads, einfo.adb: Minor code reorganization.
	* par_sco.adb: Minor reformatting.

2014-07-18  Gary Dismukes  <dismukes@adacore.com>

	* exp_ch4.adb (Real_Range_Check): Turn off
	the Do_Range_Check flag on the conversion's current Expression
	argument rather than on the originally captured Operand node,
	as Expression may reflect a rewriting (as in conversions to a
	fixed-point type).

2014-07-18  Vincent Celier  <celier@adacore.com>

	* ali.adb (Scan_ALI): Set Sdep_Record.Unit_Name, when the unit
	is not a subunit.
	* ali.ads (Sdep_Record): New component Unit_Name.
	* lib-writ.adb (Write_ALI): Write the unit name in D lines.
	* makeutl.adb (Check_Source_Info_In_ALI): Return False if a
	dependent unit is in a project and the source file name is not
	one of its sources.

From-SVN: r212795
This commit is contained in:
Arnaud Charlet 2014-07-18 11:44:45 +02:00
parent 47a98b977d
commit 8b034336be
11 changed files with 113 additions and 42 deletions

32
gcc/ada/ChangeLog

@ -1,3 +1,35 @@
2014-07-18 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb (Replace_Type_References_Generic): Use type entity
as a parameter, rather than its Chars field, in order to locate
freeze node of type. If the predicate or invariant has references
to types other than the one to which the contract applies, these
types must be frozen, and the corresponding predicate functions
created, before that freeze node.
2014-07-18 Robert Dewar <dewar@adacore.com>
* freeze.adb, einfo.ads, einfo.adb: Minor code reorganization.
* par_sco.adb: Minor reformatting.
2014-07-18 Gary Dismukes <dismukes@adacore.com>
* exp_ch4.adb (Real_Range_Check): Turn off
the Do_Range_Check flag on the conversion's current Expression
argument rather than on the originally captured Operand node,
as Expression may reflect a rewriting (as in conversions to a
fixed-point type).
2014-07-18 Vincent Celier <celier@adacore.com>
* ali.adb (Scan_ALI): Set Sdep_Record.Unit_Name, when the unit
is not a subunit.
* ali.ads (Sdep_Record): New component Unit_Name.
* lib-writ.adb (Write_ALI): Write the unit name in D lines.
* makeutl.adb (Check_Source_Info_In_ALI): Return False if a
dependent unit is in a project and the source file name is not
one of its sources.
2014-07-18 Bob Duff <duff@adacore.com>
* s-addima.ads: Minor: add comment.

16
gcc/ada/ali.adb

@ -2317,9 +2317,10 @@ package body ALI is
end if;
end;
-- Acquire subunit and reference file name entries
-- Acquire (sub)unit and reference file name entries
Sdep.Table (Sdep.Last).Subunit_Name := No_Name;
Sdep.Table (Sdep.Last).Unit_Name := No_Name;
Sdep.Table (Sdep.Last).Rfile :=
Sdep.Table (Sdep.Last).Sfile;
Sdep.Table (Sdep.Last).Start_Line := 1;
@ -2327,7 +2328,7 @@ package body ALI is
if not At_Eol then
Skip_Space;
-- Here for subunit name
-- Here for (sub)unit name
if Nextc not in '0' .. '9' then
Name_Len := 0;
@ -2335,11 +2336,18 @@ package body ALI is
Add_Char_To_Name_Buffer (Getc);
end loop;
-- Set the subunit name. Note that we use Name_Find rather
-- Set the (sub)unit name. Note that we use Name_Find rather
-- than Name_Enter here as the subunit name may already
-- have been put in the name table by the Project Manager.
Sdep.Table (Sdep.Last).Subunit_Name := Name_Find;
if Name_Len <= 2
or else Name_Buffer (Name_Len - 1) /= '%'
then
Sdep.Table (Sdep.Last).Subunit_Name := Name_Find;
else
Name_Len := Name_Len - 2;
Sdep.Table (Sdep.Last).Unit_Name := Name_Find;
end if;
Skip_Space;
end if;

3
gcc/ada/ali.ads

@ -767,6 +767,9 @@ package ALI is
Subunit_Name : Name_Id;
-- Name_Id for subunit name if present, else No_Name
Unit_Name : Name_Id;
-- Name_Id for the unit name, if not a subunit. No_Name for a subunit.
Rfile : File_Name_Type;
-- Reference file name. Same as Sfile unless a Source_Reference pragma
-- was used, in which case it reflects the name used in the pragma.

9
gcc/ada/einfo.adb

@ -7017,6 +7017,15 @@ package body Einfo is
Ekind (Id) = E_Abstract_State and then Nkind (Parent (Id)) = N_Null;
end Is_Null_State;
---------------------
-- Is_Packed_Array --
---------------------
function Is_Packed_Array (Id : E) return B is
begin
return Is_Array_Type (Id) and then Is_Packed (Id);
end Is_Packed_Array;
-----------------------------------
-- Is_Package_Or_Generic_Package --
-----------------------------------

5
gcc/ada/einfo.ads

@ -2703,6 +2703,9 @@ package Einfo is
-- out that the component size is not suitable for bit packing, the
-- Is_Packed flag gets turned off.
-- Is_Packed_Array (synth)
-- Applies to all entities, true if entity is for a packed array.
-- Is_Packed_Array_Type (Flag138)
-- Defined in all entities. This flag is set on the entity for the type
-- used to implement a packed array (either a modular type, or a subtype
@ -6874,6 +6877,7 @@ package Einfo is
function Is_Ghost_Subprogram (Id : E) return B;
function Is_Null_State (Id : E) return B;
function Is_Package_Or_Generic_Package (Id : E) return B;
function Is_Packed_Array (Id : E) return B;
function Is_Prival (Id : E) return B;
function Is_Protected_Component (Id : E) return B;
function Is_Protected_Interface (Id : E) return B;
@ -8634,6 +8638,7 @@ package Einfo is
pragma Inline (Base_Type);
pragma Inline (Is_Base_Type);
pragma Inline (Is_Package_Or_Generic_Package);
pragma Inline (Is_Packed_Array);
pragma Inline (Is_Volatile);
pragma Inline (Is_Wrapper_Package);
pragma Inline (Known_RM_Size);

8
gcc/ada/exp_ch4.adb

@ -10191,7 +10191,13 @@ package body Exp_Ch4 is
and then S_Lov >= D_Lov
and then S_Hiv <= D_Hiv
then
Set_Do_Range_Check (Operand, False);
-- Unset the range check flag on the current value of
-- Expression (N), since the captured Operand may have
-- been rewritten (such as for the case of a conversion
-- to a fixed-point type).
Set_Do_Range_Check (Expression (N), False);
return;
end if;
end;

21
gcc/ada/freeze.adb

@ -1095,20 +1095,6 @@ package body Freeze is
Component_Aliased : Boolean;
function Is_Packed_Array (T : Entity_Id) return Boolean;
-- True for a packed array type
---------------------
-- Is_Packed_Array --
---------------------
function Is_Packed_Array (T : Entity_Id) return Boolean is
begin
return Is_Array_Type (T) and then Is_Packed (T);
end Is_Packed_Array;
-- Start of processing for Check_Component_Storage_Order
begin
-- Record case
@ -1121,10 +1107,9 @@ package body Freeze is
Component_Aliased := False;
else
-- If a component clause is present, check whether component
-- starts on a storage element boundary. Otherwise conservatively
-- assume it does so only in the case where the record is not
-- packed.
-- If a component clause is present, check if the component starts
-- on a storage element boundary. Otherwise conservatively assume
-- it does so only in the case where the record is not packed.
if Present (Component_Clause (Comp)) then
Comp_Byte_Aligned :=

11
gcc/ada/lib-writ.adb

@ -1429,12 +1429,15 @@ package body Lib.Writ is
-- If subunit, add unit name, omitting the %b at the end
if Present (Cunit (Unum))
and then Nkind (Unit (Cunit (Unum))) = N_Subunit
then
if Present (Cunit (Unum)) then
Get_Decoded_Name_String (Unit_Name (Unum));
Write_Info_Char (' ');
Write_Info_Str (Name_Buffer (1 .. Name_Len - 2));
if Nkind (Unit (Cunit (Unum))) = N_Subunit then
Write_Info_Str (Name_Buffer (1 .. Name_Len - 2));
else
Write_Info_Str (Name_Buffer (1 .. Name_Len));
end if;
end if;
-- If Source_Reference pragma used, output information

9
gcc/ada/makeutl.adb

@ -320,6 +320,15 @@ package body Makeutl is
end;
end if;
Unit_Name := SD.Unit_Name;
if Unit_Name /= No_Name
and then not Fname.Is_Internal_File_Name (SD.Sfile)
and then File_Not_A_Source_Of (Tree, Unit_Name, SD.Sfile)
then
return No_Name;
end if;
else
-- For separates, the file is no longer associated with the
-- unit ("proc-sep.adb" is not associated with unit "proc.sep")

4
gcc/ada/par_sco.adb

@ -308,8 +308,8 @@ package body Par_SCO is
function Check_Node (N : Node_Id) return Traverse_Result;
-- Determine if Nkind (N) indicates the presence of a decision (i.e.
-- N is a logical operator -- a decision in itelsf -- or an
-- IF-expression -- whose Condition attribute is a decision).
-- N is a logical operator, which is a decision in itself, or an
-- IF-expression whose Condition attribute is a decision).
----------------
-- Check_Node --

37
gcc/ada/sem_ch13.adb

@ -33,6 +33,7 @@ with Errout; use Errout;
with Exp_Disp; use Exp_Disp;
with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util;
with Freeze; use Freeze;
with Lib; use Lib;
with Lib.Xref; use Lib.Xref;
with Namet; use Namet;
@ -155,14 +156,14 @@ package body Sem_Ch13 is
generic
with procedure Replace_Type_Reference (N : Node_Id);
procedure Replace_Type_References_Generic (N : Node_Id; TName : Name_Id);
procedure Replace_Type_References_Generic (N : Node_Id; T : Entity_Id);
-- This is used to scan an expression for a predicate or invariant aspect
-- replacing occurrences of the name TName (the name of the subtype to
-- which the aspect applies) with appropriate references to the parameter
-- of the predicate function or invariant procedure. The procedure passed
-- as a generic parameter does the actual replacement of node N, which is
-- either a simple direct reference to TName, or a selected component that
-- represents an appropriately qualified occurrence of TName.
-- replacing occurrences of the name of the subtype to which the aspect
-- applies with appropriate references to the parameter of the predicate
-- function or invariant procedure. The procedure passed as a generic
-- parameter does the actual replacement of node N, which is either a
-- simple direct reference to T, or a selected component that represents
-- an appropriately qualified occurrence of T.
procedure Resolve_Iterable_Operation
(N : Node_Id;
@ -7216,7 +7217,7 @@ package body Sem_Ch13 is
-- with references to the object, converted to type'Class in
-- the case of Invariant'Class aspects.
Replace_Type_References (Exp, Chars (T));
Replace_Type_References (Exp, T);
-- If this invariant comes from an aspect, find the aspect
-- specification, and replace the saved expression because
@ -7268,7 +7269,7 @@ package body Sem_Ch13 is
Inv : constant Node_Id :=
Expression (Corresponding_Aspect (Ritem));
begin
Replace_Type_References (Inv, Chars (T));
Replace_Type_References (Inv, T);
Preanalyze_Assert_Expression (Inv, Standard_Boolean);
end;
end if;
@ -7656,7 +7657,7 @@ package body Sem_Ch13 is
-- We need to replace any occurrences of the name of the
-- type with references to the object.
Replace_Type_References (Arg2, Chars (Typ));
Replace_Type_References (Arg2, Typ);
-- If this predicate comes from an aspect, find the aspect
-- specification, and replace the saved expression because
@ -10303,7 +10304,7 @@ package body Sem_Ch13 is
Replace (N, Make_Null_Statement (Sloc (N)));
-- The null statement must be marked as not coming from source. This is
-- so that ASIS ignores if, and also the back end does not expect bogus
-- so that ASIS ignores it, and also the back end does not expect bogus
-- "from source" null statements in weird places (e.g. in declarative
-- regions where such null statements are not allowed).
@ -10837,7 +10838,8 @@ package body Sem_Ch13 is
-- Replace_Type_References_Generic --
-------------------------------------
procedure Replace_Type_References_Generic (N : Node_Id; TName : Name_Id) is
procedure Replace_Type_References_Generic (N : Node_Id; T : Entity_Id) is
TName : constant Name_Id := Chars (T);
function Replace_Node (N : Node_Id) return Traverse_Result;
-- Processes a single node in the traversal procedure below, checking
@ -10859,9 +10861,18 @@ package body Sem_Ch13 is
if Nkind (N) = N_Identifier then
-- If not the type name, all done with this node
-- If not the type name, check whether it is a reference to
-- some other type, which must be frozen before the predicate
-- function is analyzed, i.e. before the freeze node of the
-- type to which the predicate applies.
if Chars (N) /= TName then
if Present (Current_Entity (N))
and then Is_Type (Current_Entity (N))
then
Freeze_Before (Freeze_Node (T), Current_Entity (N));
end if;
return Skip;
-- Otherwise do the replacement and we are done with this node