diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 50 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/sem_ch12.adb | 38 | ||||
| -rw-r--r-- | gcc/ada/sem_ch12.ads | 28 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/sem_elab.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 29 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.ads | 21 | ||||
| -rw-r--r-- | gcc/ada/sinput-c.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/sinput-l.adb | 27 | ||||
| -rw-r--r-- | gcc/ada/sinput-l.ads | 19 | ||||
| -rw-r--r-- | gcc/ada/sinput.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/sinput.ads | 18 | ||||
| -rw-r--r-- | gcc/ada/xref_lib.adb | 16 |
15 files changed, 238 insertions, 56 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index bbd98c4..6973528 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,53 @@ +2016-07-04 Bob Duff <duff@adacore.com> + + * xref_lib.adb (Parse_X_Filename, Parse_Identifier_Info): Ignore + unknown files. Check that File_Nr is in the range of files we + know about. The previous code was checking the lower bound, + but not the upper bound. + +2016-07-04 Arnaud Charlet <charlet@adacore.com> + + * tracebak.c: Minor reformatting. + +2016-07-04 Yannick Moy <moy@adacore.com> + + * sem_ch12.adb, sem_ch12.ads Update calls to + Create_Instantiation_Source to use default argument. + (Adjust_Inherited_Pragma_Sloc): New function to adjust sloc + of inherited pragma. + (Set_Copied_Sloc_For_Inherited_Pragma): + New function that wraps call to Create_Instantiation_Source for + copying an inherited pragma. + (Set_Copied_Sloc_For_Inlined_Body): Update call to + Create_Instantiation_Source with new arguments. + * sem_prag.adb (Build_Pragma_Check_Equivalent): In the case + of inherited pragmas, use the generic machinery to get chained + locations for the pragma and its sub-expressions. + * sinput-c.adb: Adapt to new type Source_File_Record. + * sinput-l.adb, sinput-l.ads (Create_Instantiation_Source): + Add parameter Inherited_Pragma and make parameter Inlined_Body + optional. + * sinput.adb, sinput.ads (Comes_From_Inherited_Pragma): New + function to return when a location comes from an inherited pragma. + (Inherited_Pragma): New function to detect when a location comes + from an inherited pragma. + (Source_File_Record): New component Inherited_Pragma. + +2016-07-04 Yannick Moy <moy@adacore.com> + + * sem_elab.adb: Register existence of quickfix for error message. + +2016-07-04 Ed Schonberg <schonberg@adacore.com> + + * sem_ch4.adb (Resolve_One_Call): In the context of a predicate + function the formal and the actual in a call may have different + views of the same type, because of the delayed analysis of + predicates aspects. Extend the patch that handles this potential + discrepancy to handle private and full views as well. + * sem_ch8.adb (Find_Selected_Component): Refine predicate that + produces additional error when an illegal selected component + looks like a prefixed call whose first formal is untagged. + 2016-07-04 Justin Squirek <squirek@adacore.com> * einfo.adb (Has_Pragma_Unused): Create this function as a setter diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 6596d53..3850ca5 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1440,13 +1440,15 @@ package body Freeze is A_Pre := Find_Aspect (Par_Prim, Aspect_Pre); if Present (A_Pre) and then Class_Present (A_Pre) then - Build_Classwide_Expression (Expression (A_Pre), Prim); + Build_Classwide_Expression (Expression (A_Pre), Prim, + Adjust_Sloc => False); end if; A_Post := Find_Aspect (Par_Prim, Aspect_Post); if Present (A_Post) and then Class_Present (A_Post) then - Build_Classwide_Expression (Expression (A_Post), Prim); + Build_Classwide_Expression (Expression (A_Post), Prim, + Adjust_Sloc => False); end if; end if; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index f62c30f..8e38db0 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -1052,6 +1052,15 @@ package body Sem_Ch12 is SPARK_Mode_Pragma => SPARK_Mode_Pragma)); end Add_Pending_Instantiation; + ---------------------------------- + -- Adjust_Inherited_Pragma_Sloc -- + ---------------------------------- + + procedure Adjust_Inherited_Pragma_Sloc (N : Node_Id) is + begin + Adjust_Instantiation_Sloc (N, S_Adjustment); + end Adjust_Inherited_Pragma_Sloc; + -------------------------- -- Analyze_Associations -- -------------------------- @@ -2641,7 +2650,7 @@ package body Sem_Ch12 is end if; Formal := New_Copy (Pack_Id); - Create_Instantiation_Source (N, Gen_Unit, False, S_Adjustment); + Create_Instantiation_Source (N, Gen_Unit, S_Adjustment); -- Make local generic without formals. The formals will be replaced with -- internal declarations. @@ -3786,7 +3795,7 @@ package body Sem_Ch12 is -- validate an actual package, the instantiation environment is that -- of the enclosing instance. - Create_Instantiation_Source (N, Gen_Unit, False, S_Adjustment); + Create_Instantiation_Source (N, Gen_Unit, S_Adjustment); -- Copy original generic tree, to produce text for instantiation @@ -5138,7 +5147,7 @@ package body Sem_Ch12 is Generic_Renamings.Set_Last (0); Generic_Renamings_HTable.Reset; - Create_Instantiation_Source (N, Gen_Unit, False, S_Adjustment); + Create_Instantiation_Source (N, Gen_Unit, S_Adjustment); -- Copy original generic tree, to produce text for instantiation @@ -7646,7 +7655,6 @@ package body Sem_Ch12 is Create_Instantiation_Source (Instantiation_Node, Defining_Entity (N), - False, S_Adjustment); end if; @@ -10888,7 +10896,7 @@ package body Sem_Ch12 is Gen_Body := Unit_Declaration_Node (Gen_Body_Id); Create_Instantiation_Source - (Inst_Node, Gen_Body_Id, False, S_Adjustment); + (Inst_Node, Gen_Body_Id, S_Adjustment); Act_Body := Copy_Generic_Node @@ -11229,7 +11237,6 @@ package body Sem_Ch12 is Create_Instantiation_Source (Inst_Node, Gen_Body_Id, - False, S_Adjustment); Act_Body := @@ -15139,13 +15146,30 @@ package body Sem_Ch12 is end loop; end Save_Global_References_In_Aspects; + ------------------------------------------ + -- Set_Copied_Sloc_For_Inherited_Pragma -- + ------------------------------------------ + + procedure Set_Copied_Sloc_For_Inherited_Pragma + (N : Node_Id; + E : Entity_Id) is + begin + Create_Instantiation_Source (N, E, + Inlined_Body => False, + Inherited_Pragma => True, + A => S_Adjustment); + end Set_Copied_Sloc_For_Inherited_Pragma; + -------------------------------------- -- Set_Copied_Sloc_For_Inlined_Body -- -------------------------------------- procedure Set_Copied_Sloc_For_Inlined_Body (N : Node_Id; E : Entity_Id) is begin - Create_Instantiation_Source (N, E, True, S_Adjustment); + Create_Instantiation_Source (N, E, + Inlined_Body => True, + Inherited_Pragma => False, + A => S_Adjustment); end Set_Copied_Sloc_For_Inlined_Body; --------------------- diff --git a/gcc/ada/sem_ch12.ads b/gcc/ada/sem_ch12.ads index c95396a..8365ac4 100644 --- a/gcc/ada/sem_ch12.ads +++ b/gcc/ada/sem_ch12.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -172,6 +172,32 @@ package Sem_Ch12 is -- saved as part of the internal state of the Sem_Ch12 package for use -- in subsequent calls to copy nodes. + procedure Set_Copied_Sloc_For_Inherited_Pragma + (N : Node_Id; + E : Entity_Id); + -- This procedure is used when a class-wide pre- or postcondition is + -- inherited. This process shares the same circuitry as the creation of + -- an instantiated copy of a generic template. The call to this procedure + -- establishes a new source file entry representing the inherited pragma + -- as an instantiation, marked as an inherited pragma (so that errout can + -- distinguish cases for generating error messages, otherwise the treatment + -- is identical). In this call N is the subprogram declaration from + -- which the pragma is inherited and E is the defining identifier of + -- the overridding subprogram (when the subprogram is redefined) or the + -- defining identifier of the extension type (when the subprogram is + -- inherited). The resulting Sloc adjustment factor is saved as part of the + -- internal state of the Sem_Ch12 package for use in subsequent calls to + -- copy nodes. + + procedure Adjust_Inherited_Pragma_Sloc (N : Node_Id); + -- This procedure is used when a class-wide pre- or postcondition + -- is inherited. It is called on each node of the pragma expression + -- to adjust its sloc. These call should be preceded by a call to + -- Set_Copied_Sloc_For_Inherited_Pragma that sets the required sloc + -- adjustment. This is done directly, instead of using Copy_Generic_Node + -- to copy nodes and adjust slocs, as Copy_Generic_Node expects a specific + -- structure to be in place, which is not the case for inherited pragmas. + procedure Save_Env (Gen_Unit : Entity_Id; Act_Unit : Entity_Id); diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 66a2acf..6b1e5de 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -3413,9 +3413,17 @@ package body Sem_Ch4 is -- an incomplete type, while resolution of the corresponding -- predicate function may see the full view, as a consequence -- of the delayed resolution of the corresponding expressions. + -- This can occur in the body of a predicate function, or in + -- a call to such. - elsif Ekind (Etype (Formal)) = E_Incomplete_Type - and then Full_View (Etype (Formal)) = Etype (Actual) + elsif ((Ekind (Current_Scope) = E_Function + and then Is_Predicate_Function (Current_Scope)) + or else (Ekind (Nam) = E_Function + and then Is_Predicate_Function (Nam))) + and then + (Base_Type (Underlying_Type (Etype (Formal))) = + Base_Type (Underlying_Type (Etype (Actual)))) + and then Serious_Errors_Detected = 0 then Set_Etype (Formal, Etype (Actual)); Next_Actual (Actual); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 0f43ecf..e4aa908 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -6983,7 +6983,8 @@ package body Sem_Ch8 is elsif Nkind (P) /= N_Attribute_Reference then -- This may have been meant as a prefixed call to a primitive - -- of an untagged type. + -- of an untagged type. If it is a function call check type of + -- its first formal and add explanation. declare F : constant Entity_Id := @@ -6992,8 +6993,7 @@ package body Sem_Ch8 is if Present (F) and then Is_Overloadable (F) and then Present (First_Entity (F)) - and then Etype (First_Entity (F)) = Etype (P) - and then not Is_Tagged_Type (Etype (P)) + and then not Is_Tagged_Type (Etype (First_Entity (F))) then Error_Msg_N ("prefixed call is only allowed for objects " diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 1b3015a..d963def 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -1097,7 +1097,8 @@ package body Sem_Elab is -- is an error, so give an error message. if Issue_In_SPARK then - Error_Msg_NE ("\Elaborate_All pragma required for&", N, W_Scope); + Error_Msg_NE -- CODEFIX + ("\Elaborate_All pragma required for&", N, W_Scope); -- Otherwise we generate an implicit pragma. For a subprogram -- instantiation, Elaborate is good enough, since no transitive diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 999ae35..8cda6c7 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -26395,7 +26395,11 @@ package body Sem_Prag is -- Build_Classwide_Expression -- -------------------------------- - procedure Build_Classwide_Expression (Prag : Node_Id; Subp : Entity_Id) is + procedure Build_Classwide_Expression + (Prag : Node_Id; + Subp : Entity_Id; + Adjust_Sloc : Boolean) + is function Replace_Entity (N : Node_Id) return Traverse_Result; -- Replace reference to formal of inherited operation or to primitive -- operation of root type, with corresponding entity for derived type, @@ -26410,6 +26414,10 @@ package body Sem_Prag is New_E : Entity_Id; begin + if Adjust_Sloc then + Adjust_Inherited_Pragma_Sloc (N); + end if; + if Nkind (N) = N_Identifier and then Present (Entity (N)) and then @@ -26576,15 +26584,22 @@ package body Sem_Prag is Next_Formal (Inher_Formal); Next_Formal (Subp_Formal); end loop; - end if; - -- Copy the original pragma while performing substitutions (if - -- applicable). + -- Use generic machinery to copy inherited pragma, as if it were an + -- instantiation, resetting source locations appropriately, so that + -- expressions inside the inherited pragma use chained locations. + -- This is used in particular in GNATprove to locate precisely + -- messages on a given inherited pragma. - Check_Prag := New_Copy_Tree (Source => Prag); + Set_Copied_Sloc_For_Inherited_Pragma + (Unit_Declaration_Node (Subp_Id), Inher_Id); + Check_Prag := New_Copy_Tree (Source => Prag); + Build_Classwide_Expression (Check_Prag, Subp_Id, Adjust_Sloc => True); - if Present (Inher_Id) then - Build_Classwide_Expression (Check_Prag, Subp_Id); + -- Otherwise simply copy the original pragma + + else + Check_Prag := New_Copy_Tree (Source => Prag); end if; -- Mark the pragma as being internally generated and reset the Analyzed diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads index db7bcbb..9a951ff 100644 --- a/gcc/ada/sem_prag.ads +++ b/gcc/ada/sem_prag.ads @@ -244,16 +244,21 @@ package Sem_Prag is procedure Analyze_Test_Case_In_Decl_Part (N : Node_Id); -- Perform preanalysis of pragma Test_Case - procedure Build_Classwide_Expression (Prag : Node_Id; Subp : Entity_Id); + procedure Build_Classwide_Expression + (Prag : Node_Id; + Subp : Entity_Id; + Adjust_Sloc : Boolean); -- Build the expression for an inherited classwide condition. Prag is -- the pragma constructed from the corresponding aspect of the parent - -- subprogram, and Subp is the overridding operation. - -- The routine is also called to check whether an inherited operation - -- that is not overridden but has inherited conditions need a wrapper, - -- because the inherited condition includes calls to other primitives that - -- have been overridden. In that case the first argument is the expression - -- of the original classwide aspect. In SPARK_Mode, such operation which - -- are just inherited but have modified pre/postconditions are illegal. + -- subprogram, and Subp is the overridding operation. Adjust_Sloc is True + -- when the sloc of nodes traversed should be adjusted for the inherited + -- pragma. The routine is also called to check whether an inherited + -- operation that is not overridden but has inherited conditions need + -- a wrapper, because the inherited condition includes calls to other + -- primitives that have been overridden. In that case the first argument + -- is the expression of the original classwide aspect. In SPARK_Mode, such + -- operation which are just inherited but have modified pre/postconditions + -- are illegal. function Build_Pragma_Check_Equivalent (Prag : Node_Id; diff --git a/gcc/ada/sinput-c.adb b/gcc/ada/sinput-c.adb index 6c3d582..3ef0f5a 100644 --- a/gcc/ada/sinput-c.adb +++ b/gcc/ada/sinput-c.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -183,6 +183,7 @@ package body Sinput.C is Identifier_Casing => Unknown, Inlined_Call => No_Location, Inlined_Body => False, + Inherited_Pragma => False, Keyword_Casing => Unknown, Last_Source_Line => 1, License => Unknown, diff --git a/gcc/ada/sinput-l.adb b/gcc/ada/sinput-l.adb index c084555..32c2ac2 100644 --- a/gcc/ada/sinput-l.adb +++ b/gcc/ada/sinput-l.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -121,10 +121,11 @@ package body Sinput.L is --------------------------------- procedure Create_Instantiation_Source - (Inst_Node : Entity_Id; - Template_Id : Entity_Id; - Inlined_Body : Boolean; - A : out Sloc_Adjustment) + (Inst_Node : Entity_Id; + Template_Id : Entity_Id; + A : out Sloc_Adjustment; + Inlined_Body : Boolean := False; + Inherited_Pragma : Boolean := False) is Dnod : constant Node_Id := Declaration_Node (Template_Id); Xold : Source_File_Index; @@ -145,16 +146,21 @@ package body Sinput.L is Inst_Spec : Node_Id; begin - Snew.Inlined_Body := Inlined_Body; - Snew.Template := Xold; + Snew.Inlined_Body := Inlined_Body; + Snew.Inherited_Pragma := Inherited_Pragma; + Snew.Template := Xold; - -- For a genuine generic instantiation, assign new instance id. - -- For inlined bodies, we retain that of the template, but we - -- save the call location. + -- For a genuine generic instantiation, assign new instance id. For + -- inlined bodies, we retain that of the template, but we save the + -- call location. For inherited pragmas, we simply retain that of + -- the template. if Inlined_Body then Snew.Inlined_Call := Sloc (Inst_Node); + elsif Inherited_Pragma then + null; + else -- If the spec has been instantiated already, and we are now -- creating the instance source for the corresponding body now, @@ -509,6 +515,7 @@ package body Sinput.L is Identifier_Casing => Unknown, Inlined_Call => No_Location, Inlined_Body => False, + Inherited_Pragma => False, Keyword_Casing => Unknown, Last_Source_Line => 1, License => Unknown, diff --git a/gcc/ada/sinput-l.ads b/gcc/ada/sinput-l.ads index 9cb2948..1b0aacb 100644 --- a/gcc/ada/sinput-l.ads +++ b/gcc/ada/sinput-l.ads @@ -83,19 +83,22 @@ package Sinput.L is -- calls to Adjust_Instantiation_Sloc. procedure Create_Instantiation_Source - (Inst_Node : Entity_Id; - Template_Id : Entity_Id; - Inlined_Body : Boolean; - A : out Sloc_Adjustment); + (Inst_Node : Entity_Id; + Template_Id : Entity_Id; + A : out Sloc_Adjustment; + Inlined_Body : Boolean := False; + Inherited_Pragma : Boolean := False); -- This procedure creates the source table entry for an instantiation. -- Inst_Node is the instantiation node, and Template_Id is the defining -- identifier of the generic declaration or body unit as appropriate. -- A is set to an adjustment factor to be used in subsequent calls to -- Adjust_Instantiation_Sloc. The instantiation mechanism is also used - -- for inlined function and procedure calls. The parameter Inlined_Body - -- is set to True in such cases, and False for a generic instantiation. - -- This is used for generating error messages that distinguish these - -- two cases, otherwise the two cases are handled identically. + -- for inlined function and procedure calls. The parameter Inlined_Body is + -- set to True in such cases. This is used for generating error messages + -- that distinguish these two cases, otherwise the two cases are handled + -- identically. Similarly, the instantiation mechanism is also used + -- for inherited class-wide pre- and postconditions. The parameter + -- Inherited_Pragma is set to True in such cases. procedure Adjust_Instantiation_Sloc (N : Node_Id; A : Sloc_Adjustment); -- The instantiation tree is created by copying the tree of the generic diff --git a/gcc/ada/sinput.adb b/gcc/ada/sinput.adb index 0800f31..0105b2c 100644 --- a/gcc/ada/sinput.adb +++ b/gcc/ada/sinput.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -300,6 +300,17 @@ package body Sinput is end case; end Check_For_BOM; + --------------------------------- + -- Comes_From_Inherited_Pragma -- + --------------------------------- + + function Comes_From_Inherited_Pragma (S : Source_Ptr) return Boolean is + SIE : Source_File_Record renames + Source_File.Table (Get_Source_File_Index (S)); + begin + return SIE.Inherited_Pragma; + end Comes_From_Inherited_Pragma; + ----------------------------- -- Comes_From_Inlined_Body -- ----------------------------- @@ -1190,6 +1201,11 @@ package body Sinput is return Source_File.Table (S).Identifier_Casing; end Identifier_Casing; + function Inherited_Pragma (S : SFI) return Boolean is + begin + return Source_File.Table (S).Inherited_Pragma; + end Inherited_Pragma; + function Inlined_Body (S : SFI) return Boolean is begin return Source_File.Table (S).Inlined_Body; diff --git a/gcc/ada/sinput.ads b/gcc/ada/sinput.ads index 24f1a68..21f16f2 100644 --- a/gcc/ada/sinput.ads +++ b/gcc/ada/sinput.ads @@ -269,6 +269,11 @@ package Sinput is -- an instance of an inlined body. -- ??? Redundant, always equal to (Inlined_Call /= No_Location) + -- Inherited_Pragma : Boolean; + -- This can only be set True if Instantiation has a value other than + -- No_Location. If true it indicates that the instantiation is actually + -- an inherited class-wide pre- or postcondition. + -- Template : Source_File_Index; (read-only) -- Source file index of the source file containing the template if this -- is a generic instantiation. Set to No_Source_File for the normal case @@ -298,6 +303,7 @@ package Sinput is function Full_Ref_Name (S : SFI) return File_Name_Type; function Identifier_Casing (S : SFI) return Casing_Type; function Inlined_Body (S : SFI) return Boolean; + function Inherited_Pragma (S : SFI) return Boolean; function Inlined_Call (S : SFI) return Source_Ptr; function Instance (S : SFI) return Instance_Id; function Keyword_Casing (S : SFI) return Casing_Type; @@ -644,6 +650,13 @@ package Sinput is -- from instantiation of generics, since Instantiation_Location returns a -- valid location in both cases. + function Comes_From_Inherited_Pragma (S : Source_Ptr) return Boolean; + pragma Inline (Comes_From_Inherited_Pragma); + -- Given a source pointer S, returns whether it comes from an inherited + -- pragma. This allows distinguishing these source pointers from those + -- that come from instantiation of generics, since Instantiation_Location + -- returns a valid location in both cases. + function Top_Level_Location (S : Source_Ptr) return Source_Ptr; -- Given a source pointer S, returns the argument unchanged if it is -- not in an instantiation. If S is in an instantiation, then it returns @@ -759,6 +772,7 @@ private pragma Inline (Identifier_Casing); pragma Inline (Inlined_Call); pragma Inline (Inlined_Body); + pragma Inline (Inherited_Pragma); pragma Inline (Template); pragma Inline (Unit); @@ -824,6 +838,7 @@ private File_Type : Type_Of_File; Inlined_Call : Source_Ptr; Inlined_Body : Boolean; + Inherited_Pragma : Boolean; License : License_Type; Keyword_Casing : Casing_Type; Identifier_Casing : Casing_Type; @@ -881,7 +896,8 @@ private Time_Stamp at 60 range 0 .. 8 * Time_Stamp_Length - 1; File_Type at 74 range 0 .. 7; Inlined_Call at 88 range 0 .. 31; - Inlined_Body at 75 range 0 .. 7; + Inlined_Body at 75 range 0 .. 0; + Inherited_Pragma at 75 range 1 .. 1; License at 76 range 0 .. 7; Keyword_Casing at 77 range 0 .. 7; Identifier_Casing at 78 range 0 .. 15; diff --git a/gcc/ada/xref_lib.adb b/gcc/ada/xref_lib.adb index 2afec82..7cb7f10 100644 --- a/gcc/ada/xref_lib.adb +++ b/gcc/ada/xref_lib.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -890,8 +890,12 @@ package body Xref_Lib is Parse_Token (Ali, Ptr, E_Name); - -- Exit if the symbol does not match - -- or if we have a local symbol and we do not want it + -- Exit if the symbol does not match or if we have a local + -- symbol and we do not want it or if the file is unknown. + + if File.X_File = Empty_File then + return; + end if; if (not Local_Symbols and not E_Global) or else (Pattern.Initialized @@ -1261,8 +1265,12 @@ package body Xref_Lib is Ptr := Ptr + 1; Parse_Number (Ali, Ptr, File_Nr); - if File_Nr > 0 then + -- If the referenced file is unknown, we simply ignore it + + if File_Nr in Dependencies_Tables.First .. Last (File.Dep) then File.X_File := File.Dep.Table (File_Nr); + else + File.X_File := Empty_File; end if; Parse_EOL (Ali, Ptr); |