procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2012-04-02  Robert Dewar  <dewar@adacore.com>

	* s-atopri.ads: Minor reformatting.

2012-04-02  Thomas Quinot  <quinot@adacore.com>

	* sem_util.adb: Minor reformatting, minor code cleanup.

2012-04-02  Ed Schonberg  <schonberg@adacore.com>

	* 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  <celier@adacore.com>

	* 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.

From-SVN: r186079
This commit is contained in:
Arnaud Charlet 2012-04-02 12:51:58 +02:00
parent 5bd5034e24
commit cf5ba8a881
11 changed files with 161 additions and 43 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
gcc/ada/ChangeLog
View file

@ -1,3 +1,37 @@
2012-04-02 Robert Dewar <dewar@adacore.com>
* s-atopri.ads: Minor reformatting.
2012-04-02 Thomas Quinot <quinot@adacore.com>
* sem_util.adb: Minor reformatting, minor code cleanup.
2012-04-02 Ed Schonberg <schonberg@adacore.com>
* 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 <celier@adacore.com>
* 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 <moy@adacore.com>
* osint.adb, osint.ads (Add_Default_Search_Dirs): Add library

10
gcc/ada/ali.adb
View file

@ -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

5
gcc/ada/ali.ads
View file

@ -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 (

3
gcc/ada/csinfo.adb
View file

@ -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);

22
gcc/ada/lib-writ.adb
View file

@ -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;

28
gcc/ada/lib-xref.adb
View file

@ -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

2
gcc/ada/s-atopri.ads
View file

@ -29,6 +29,8 @@
-- --
------------------------------------------------------------------------------
-- ??? Need header saying what this unit is!!!
package System.Atomic_Primitives is
pragma Preelaborate;

34
gcc/ada/sem_ch12.adb
View file

@ -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;

39
gcc/ada/sem_util.adb
View file

@ -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;

16
gcc/ada/sinfo.adb
View file

@ -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

11
gcc/ada/sinfo.ads
View file

@ -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);