From 2a9b01cb49d882a1c627b130572b408c529e9989 Mon Sep 17 00:00:00 2001 From: charlet Date: Mon, 2 Apr 2012 10:51:58 +0000 Subject: [PATCH] 2012-04-02 Robert Dewar * s-atopri.ads: Minor reformatting. 2012-04-02 Thomas Quinot * sem_util.adb: Minor reformatting, minor code cleanup. 2012-04-02 Ed Schonberg * lib-xref.adb (Generate_Reference): For a reference to an operator symbol, set the sloc to point to the first character of the operator name, and not to the initial quaote. (Output_References): Ditto for the definition of an operator symbol. 2012-04-02 Vincent Celier * ali.adb (Scan_Ali): Recognize Z lines. Set Implicit_With_From_Instantiation to True in the With_Record for Z lines. * ali.ads (With_Record): New Boolean component Implicit_With_From_Instantiation, defaulted to False. * csinfo.adb: Indicate that Implicit_With_From_Instantiation is special * lib-writ.adb (Write_ALI): New array Implicit_With. (Collect_Withs): Set Implicit_With for the unit is it is not Yes. (Write_With_Lines): Write a Z line instead of a W line if Implicit_With is Yes for the unit. * sem_ch12.adb (Inherit_Context): Only add a unit in the context if it is not there yet. * sinfo.ads: New flag Implicit_With_From_Instantiation (Flag12) added. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@186079 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 34 ++++++++++++++++++++++++++++++++++ gcc/ada/ali.adb | 10 +++++++--- gcc/ada/ali.ads | 5 ++++- gcc/ada/csinfo.adb | 3 ++- gcc/ada/lib-writ.adb | 22 ++++++++++++++++++++-- gcc/ada/lib-xref.adb | 28 +++++++++++++++++++++++++--- gcc/ada/s-atopri.ads | 2 ++ gcc/ada/sem_ch12.adb | 34 +++++++++++++++++++++++++--------- gcc/ada/sem_util.adb | 39 +++++++++++++++------------------------ gcc/ada/sinfo.adb | 16 ++++++++++++++++ gcc/ada/sinfo.ads | 11 +++++++++++ 11 files changed, 161 insertions(+), 43 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 26f77b8..69c2a84 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,37 @@ +2012-04-02 Robert Dewar + + * s-atopri.ads: Minor reformatting. + +2012-04-02 Thomas Quinot + + * sem_util.adb: Minor reformatting, minor code cleanup. + +2012-04-02 Ed Schonberg + + * lib-xref.adb (Generate_Reference): For a reference to an + operator symbol, set the sloc to point to the first character + of the operator name, and not to the initial quaote. + (Output_References): Ditto for the definition of an operator + symbol. + +2012-04-02 Vincent Celier + + * ali.adb (Scan_Ali): Recognize Z lines. Set + Implicit_With_From_Instantiation to True in the With_Record for + Z lines. + * ali.ads (With_Record): New Boolean component + Implicit_With_From_Instantiation, defaulted to False. + * csinfo.adb: Indicate that Implicit_With_From_Instantiation + is special + * lib-writ.adb (Write_ALI): New array Implicit_With. + (Collect_Withs): Set Implicit_With for the unit is it is not Yes. + (Write_With_Lines): Write a Z line instead of a W line if + Implicit_With is Yes for the unit. + * sem_ch12.adb (Inherit_Context): Only add a unit in the context + if it is not there yet. + * sinfo.ads: New flag Implicit_With_From_Instantiation (Flag12) + added. + 2012-04-02 Yannick Moy * osint.adb, osint.ads (Add_Default_Search_Dirs): Add library diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index 93dd109..28307ac 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -55,6 +55,7 @@ package body ALI is 'X' => True, -- xref 'S' => True, -- specific dispatching 'Y' => True, -- limited_with + 'Z' => True, -- implicit with from instantiation 'C' => True, -- SCO information 'F' => True, -- Alfa information others => False); @@ -782,7 +783,8 @@ package body ALI is -- Acquire lines to be ignored if Read_Xref then - Ignore := ('U' | 'W' | 'Y' | 'D' | 'X' => False, others => True); + Ignore := + ('U' | 'W' | 'Y' | 'Z' | 'D' | 'X' => False, others => True); -- Read_Lines parameter given @@ -1717,7 +1719,7 @@ package body ALI is With_Loop : loop Check_Unknown_Line; - exit With_Loop when C /= 'W' and then C /= 'Y'; + exit With_Loop when C /= 'W' and then C /= 'Y' and then C /= 'Z'; if Ignore ('W') then Skip_Line; @@ -1733,6 +1735,8 @@ package body ALI is Withs.Table (Withs.Last).Elab_All_Desirable := False; Withs.Table (Withs.Last).SAL_Interface := False; Withs.Table (Withs.Last).Limited_With := (C = 'Y'); + Withs.Table (Withs.Last).Implicit_With_From_Instantiation + := (C = 'Z'); -- Generic case with no object file available diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads index b2b9b3d..39943c4 100644 --- a/gcc/ada/ali.ads +++ b/gcc/ada/ali.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -558,6 +558,9 @@ package ALI is Limited_With : Boolean := False; -- True if unit is named in a limited_with_clause + + Implicit_With_From_Instantiation : Boolean := False; + -- True if this is an implicit with from a generic instantiation end record; package Withs is new Table.Table ( diff --git a/gcc/ada/csinfo.adb b/gcc/ada/csinfo.adb index ef319cf..024af66 100644 --- a/gcc/ada/csinfo.adb +++ b/gcc/ada/csinfo.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -218,6 +218,7 @@ begin Set (Special, "Has_Dynamic_Range_Check", True); Set (Special, "Has_Dynamic_Length_Check", True); Set (Special, "Has_Private_View", True); + Set (Special, "Implicit_With_From_Instantiation", True); Set (Special, "Is_Controlling_Actual", True); Set (Special, "Is_Overloaded", True); Set (Special, "Is_Static_Expression", True); diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index 2d67ea0..e25355b 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -196,6 +196,10 @@ package body Lib.Writ is Elab_All_Des_Flags : array (Units.First .. Last_Unit) of Boolean; -- Array of flags to show which units have Elaborate_All_Desirable set + type Yes_No is (Unknown, Yes, No); + + Implicit_With : array (Units.First .. Last_Unit) of Yes_No; + Sdep_Table : Unit_Ref_Table (1 .. Pos (Last_Unit - Units.First + 2)); -- Sorted table of source dependencies. One extra entry in case we -- have to add a dummy entry for System. @@ -276,6 +280,15 @@ package body Lib.Writ is else Set_From_With_Type (Cunit_Entity (Unum)); end if; + + if Implicit_With (Unum) /= Yes then + if Implicit_With_From_Instantiation (Item) then + Implicit_With (Unum) := Yes; + + else + Implicit_With (Unum) := No; + end if; + end if; end if; Next (Item); @@ -552,6 +565,7 @@ package body Lib.Writ is Elab_All_Flags (J) := False; Elab_Des_Flags (J) := False; Elab_All_Des_Flags (J) := False; + Implicit_With (J) := Unknown; end loop; Collect_Withs (Unode); @@ -770,10 +784,14 @@ package body Lib.Writ is Uname := Units.Table (Unum).Unit_Name; Fname := Units.Table (Unum).Unit_File_Name; - if Ekind (Cunit_Entity (Unum)) = E_Package + if Implicit_With (Unum) = Yes then + Write_Info_Initiate ('Z'); + + elsif Ekind (Cunit_Entity (Unum)) = E_Package and then From_With_Type (Cunit_Entity (Unum)) then Write_Info_Initiate ('Y'); + else Write_Info_Initiate ('W'); end if; diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index af5a69e..b6595b3 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -1031,6 +1031,15 @@ package body Lib.Xref is Ref := Original_Location (Sloc (Nod)); Def := Original_Location (Sloc (Ent)); + -- If this is an operator symbol, skip the initial + -- quote, for navigation purposes. + + if Nkind (N) = N_Defining_Operator_Symbol + or else Nkind (Nod) = N_Operator_Symbol + then + Ref := Ref + 1; + end if; + Add_Entry ((Ent => Ent, Loc => Ref, @@ -1718,11 +1727,24 @@ package body Lib.Xref is -- since at the time the reference or definition is made, private -- types may be swapped, and the Sloc value may be incorrect. We -- also set up the pointer vector for the sort. + -- For user-defined operators we need to skip the initial + -- quote and point to the first character of the name, for + -- navigation purposes. for J in 1 .. Nrefs loop - Rnums (J) := J; - Xrefs.Table (J).Def := - Original_Location (Sloc (Xrefs.Table (J).Key.Ent)); + declare + E : constant Entity_Id := Xrefs.Table (J).Key.Ent; + Loc : constant Source_Ptr := Original_Location (Sloc (E)); + + begin + Rnums (J) := J; + + if Nkind (E) = N_Defining_Operator_Symbol then + Xrefs.Table (J).Def := Loc + 1; + else + Xrefs.Table (J).Def := Loc; + end if; + end; end loop; -- Sort the references diff --git a/gcc/ada/s-atopri.ads b/gcc/ada/s-atopri.ads index 6f39cf0..c8c75f2 100644 --- a/gcc/ada/s-atopri.ads +++ b/gcc/ada/s-atopri.ads @@ -29,6 +29,8 @@ -- -- ------------------------------------------------------------------------------ +-- ??? Need header saying what this unit is!!! + package System.Atomic_Primitives is pragma Preelaborate; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index e516ec0..d052563 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -7761,6 +7761,9 @@ package body Sem_Ch12 is Item : Node_Id; New_I : Node_Id; + Clause : Node_Id; + OK : Boolean; + begin if Nkind (Parent (Gen_Decl)) = N_Compilation_Unit then @@ -7782,17 +7785,30 @@ package body Sem_Ch12 is while Present (Item) loop if Nkind (Item) = N_With_Clause then - -- Take care to prevent direct cyclic with's, which can happen - -- if the generic body with's the current unit. Such a case - -- would result in binder errors (or run-time errors if the - -- -gnatE switch is in effect), but we want to prevent it here, - -- because Sem.Walk_Library_Items doesn't like cycles. Note - -- that we don't bother to detect indirect cycles. + -- Take care to prevent direct cyclic with's. if Library_Unit (Item) /= Current_Unit then - New_I := New_Copy (Item); - Set_Implicit_With (New_I, True); - Append (New_I, Current_Context); + -- Do not add a unit if it is already in the context + + Clause := First (Current_Context); + OK := True; + while Present (Clause) loop + if Nkind (Clause) = N_With_Clause and then + Chars (Name (Clause)) = Chars (Name (Item)) + then + OK := False; + exit; + end if; + + Next (Clause); + end loop; + + if OK then + New_I := New_Copy (Item); + Set_Implicit_With (New_I, True); + Set_Implicit_With_From_Instantiation (New_I, True); + Append (New_I, Current_Context); + end if; end if; end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index b8e4d81..b525517 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -752,11 +752,10 @@ package body Sem_Util is Bas := Base_Type (T); - -- If T is non-private but its base type is private, this is - -- the completion of a subtype declaration whose parent type - -- is private (see Complete_Private_Subtype in sem_ch3). The - -- proper discriminants are to be found in the full view of - -- the base. + -- If T is non-private but its base type is private, this is the + -- completion of a subtype declaration whose parent type is private + -- (see Complete_Private_Subtype in Sem_Ch3). The proper discriminants + -- are to be found in the full view of the base. if Is_Private_Type (Bas) and then Present (Full_View (Bas)) then Bas := Full_View (Bas); @@ -783,10 +782,10 @@ package body Sem_Util is Decl := Make_Subtype_Declaration (Loc, Defining_Identifier => Act, - Subtype_Indication => + Subtype_Indication => Make_Subtype_Indication (Loc, Subtype_Mark => New_Occurrence_Of (Bas, Loc), - Constraint => + Constraint => Make_Index_Or_Discriminant_Constraint (Loc, Constraints => Constraints))); @@ -813,8 +812,8 @@ package body Sem_Util is -- of the prefix. function Build_Discriminal_Record_Constraint return List_Id; - -- Similar to previous one, for discriminated components constrained - -- by the discriminant of the enclosing object. + -- Similar to previous one, for discriminated components constrained by + -- the discriminant of the enclosing object. ---------------------------------------- -- Build_Discriminal_Array_Constraint -- @@ -970,12 +969,7 @@ package body Sem_Util is -- and thus will not have the unit name automatically prepended. Set_Package_Name (Spec_Id); - - -- Append _E - - Name_Buffer (Name_Len + 1) := '_'; - Name_Buffer (Name_Len + 2) := 'E'; - Name_Len := Name_Len + 2; + Add_Str_To_Name_Buffer ("_E"); -- Create elaboration counter @@ -1001,9 +995,9 @@ package body Sem_Util is Set_Current_Value (Elab_Ent, Empty); Set_Last_Assignment (Elab_Ent, Empty); - -- We do not want any further qualification of the name (if we did - -- not do this, we would pick up the name of the generic package - -- in the case of a library level generic instantiation). + -- We do not want any further qualification of the name (if we did not + -- do this, we would pick up the name of the generic package in the case + -- of a library level generic instantiation). Set_Has_Qualified_Name (Elab_Ent); Set_Has_Fully_Qualified_Name (Elab_Ent); @@ -1088,8 +1082,7 @@ package body Sem_Util is then return False; else - return - Cannot_Raise_Constraint_Error (Expression (Expr)); + return Cannot_Raise_Constraint_Error (Expression (Expr)); end if; when N_Unchecked_Type_Conversion => @@ -1099,8 +1092,7 @@ package body Sem_Util is if Do_Overflow_Check (Expr) then return False; else - return - Cannot_Raise_Constraint_Error (Right_Opnd (Expr)); + return Cannot_Raise_Constraint_Error (Right_Opnd (Expr)); end if; when N_Op_Divide | @@ -1157,8 +1149,7 @@ package body Sem_Util is -- Check_Implicit_Dereference -- -------------------------------- - procedure Check_Implicit_Dereference (Nam : Node_Id; Typ : Entity_Id) - is + procedure Check_Implicit_Dereference (Nam : Node_Id; Typ : Entity_Id) is Disc : Entity_Id; Desig : Entity_Id; diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index a8388b1..a89f9b2 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -1624,6 +1624,14 @@ package body Sinfo is return Flag16 (N); end Implicit_With; + function Implicit_With_From_Instantiation + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_With_Clause); + return Flag12 (N); + end Implicit_With_From_Instantiation; + function Interface_List (N : Node_Id) return List_Id is begin @@ -4704,6 +4712,14 @@ package body Sinfo is Set_Flag16 (N, Val); end Set_Implicit_With; + procedure Set_Implicit_With_From_Instantiation + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_With_Clause); + Set_Flag12 (N, Val); + end Set_Implicit_With_From_Instantiation; + procedure Set_Interface_List (N : Node_Id; Val : List_Id) is begin diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index e9f1c8e..fa7dbee 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -1226,6 +1226,9 @@ package Sinfo is -- 'Address or 'Tag attribute. ???There are other implicit with clauses -- as well. + -- Implicit_With_From_Instantiation (Flag12-Sem) + -- Set in N_With_Clause nodes from generic instantiations. + -- Import_Interface_Present (Flag16-Sem) -- This flag is set in an Interface or Import pragma if a matching -- pragma of the other kind is also present. This is used to avoid @@ -5805,6 +5808,7 @@ package Sinfo is -- Elaborate_Desirable (Flag11-Sem) -- Private_Present (Flag15) set if with_clause has private keyword -- Implicit_With (Flag16-Sem) + -- Implicit_With_From_Instantiation (Flag12-Sem) -- Limited_Present (Flag17) set if LIMITED is present -- Limited_View_Installed (Flag18-Sem) -- Unreferenced_In_Spec (Flag7-Sem) @@ -8592,6 +8596,9 @@ package Sinfo is function Implicit_With (N : Node_Id) return Boolean; -- Flag16 + function Implicit_With_From_Instantiation + (N : Node_Id) return Boolean; -- Flag12 + function Import_Interface_Present (N : Node_Id) return Boolean; -- Flag16 @@ -9573,6 +9580,9 @@ package Sinfo is procedure Set_Implicit_With (N : Node_Id; Val : Boolean := True); -- Flag16 + procedure Set_Implicit_With_From_Instantiation + (N : Node_Id; Val : Boolean := True); -- Flag12 + procedure Set_Import_Interface_Present (N : Node_Id; Val : Boolean := True); -- Flag16 @@ -11959,6 +11969,7 @@ package Sinfo is pragma Inline (High_Bound); pragma Inline (Identifier); pragma Inline (Implicit_With); + pragma Inline (Implicit_With_From_Instantiation); pragma Inline (Interface_List); pragma Inline (Interface_Present); pragma Inline (Includes_Infinities); -- 2.7.4