* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@212795
138bc75d-0d04-0410-961f-
82ee72b054a4
+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.
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;
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;
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;
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.
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 --
-----------------------------------
-- 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
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;
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);
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;
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
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 :=
-- 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
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")
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 --
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;
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;
-- 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
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;
-- 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
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).
-- 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
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
projects / thirdparty / gcc.git / commitdiff
