From: charlet Date: Fri, 18 Jul 2014 09:44:45 +0000 (+0000) Subject: 2014-07-18 Ed Schonberg X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=37c6552ccac34bc71e1a6c086350cd80b353eb12;p=thirdparty%2Fgcc.git 2014-07-18 Ed Schonberg * 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 * freeze.adb, einfo.ads, einfo.adb: Minor code reorganization. * par_sco.adb: Minor reformatting. 2014-07-18 Gary Dismukes * 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 * 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 80c3358a6ff8..f69a5704e635 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,35 @@ +2014-07-18 Ed Schonberg + + * 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 + + * freeze.adb, einfo.ads, einfo.adb: Minor code reorganization. + * par_sco.adb: Minor reformatting. + +2014-07-18 Gary Dismukes + + * 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 + + * 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 * s-addima.ads: Minor: add comment. diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index b90c5c04da7d..73db0e88b507 100644 --- a/gcc/ada/ali.adb +++ b/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; diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index 1d7e159ef221..be5f7932b5de 100644 --- a/gcc/ada/ali.ads +++ b/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. diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 79da6f9e0f46..a2abb45775de 100644 --- a/gcc/ada/einfo.adb +++ b/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 -- ----------------------------------- diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 011e10ca3246..42439ad0ea72 100644 --- a/gcc/ada/einfo.ads +++ b/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); diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 917f98a0e73d..725efabd3bb5 100644 --- a/gcc/ada/exp_ch4.adb +++ b/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; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index ab0334e6b87a..fb359420ec9c 100644 --- a/gcc/ada/freeze.adb +++ b/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 := diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index df57c65ba7c2..1240032bc45f 100644 --- a/gcc/ada/lib-writ.adb +++ b/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 diff --git a/gcc/ada/makeutl.adb b/gcc/ada/makeutl.adb index 451895978061..36b1c6a61304 100644 --- a/gcc/ada/makeutl.adb +++ b/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") diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index 215a81a9116d..15382acf6ce7 100644 --- a/gcc/ada/par_sco.adb +++ b/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 -- diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 317510ada170..fe54f88240b0 100644 --- a/gcc/ada/sem_ch13.adb +++ b/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