+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 / platform / upstream / gcc.git / commitdiff