Skip to content

R
riscv-gcc-1
Commit e8374e7a by Arnaud Charlet
Options

[multiple changes] 

2011-08-02  Robert Dewar  <dewar@adacore.com>

	* sem_res.adb: Minor reformatting.
	* sem_prag.adb: Minor reformatting.

2011-08-02  Javier Miranda  <miranda@adacore.com>

	* exp_atag.adb, exp_atags.ads
	(Build_Common_Dispatching_Select_Statement): Replace argument DT_Ptr
	by the tagged type Entity. Required to use this routine in the VM
	targets since we do not have available the Tag entity in the VM
	platforms.
	* exp_ch6.adb
	(Expand_N_Subprogram_Body): Do not invoke Build_VM_TSDs if package
	Ada.Tags has not been previously loaded.
	* exp_ch7.adb
	(Expand_N_Package_Declaration, Expand_N_Package_Body): Do not invoke
	Build_VM_TSDs if package Ada.Tags has not been previously loaded.
	* sem_aux.adb
	(Enclosing_Dynamic_Scope): Add missing support to handle the full
	view of enclosing scopes. Required to handle enclosing scopes that
	are synchronized types whose full view is a task type.
	* exp_disp.adb
	(Build_VM_TSDs): Minor code improvement to avoid generating and
	analyzing lists with empty nodes.
	(Make_Disp_Asynchronous_Select_Body): Add support for VM targets.
	(Make_Disp_Conditional_Select_Body): Add support for VM targets.
	(Make_Disp_Get_Prim_Op_Kind): Add support for VM targets.
	(Make_Disp_Timed_Select_Body): Add support for VM targets.
	(Make_Select_Specific_Data_Table): Add support for VM targets.
	(Make_VM_TSD): Generate code to initialize the SSD structure of
	the TSD.

2011-08-02  Yannick Moy  <moy@adacore.com>

	* lib-writ.adb (Write_ALI): when ALFA mode is set, write local
	cross-references section in ALI.
	* lib-xref.adb, lib-xref.ads (Xref_Entry): add components Sub
	(enclosing subprogram), Slc (location of Sub) and Sun (unit number of
	Sub).
	(Enclosing_Subprogram_Or_Package): new function to return the enclosing
	subprogram or package entity of a node
	(Is_Local_Reference_Type): new function returns True for references
	selected in local cross-references.
	(Lt): function extracted from Lt in Output_References
	(Write_Entity_Name): function extracted from Output_References
	(Generate_Definition): generate reference with type 'D' for definition
	of objects (object declaration and parameter specification), with
	appropriate locations and units, for use in local cross-references.
	(Generate_Reference): update fields Sub, Slc and Sun. Keep newly created
	references of type 'I' for initialization in object definition.
	(Output_References): move part of function Lt and procedure
	Write_Entity_Name outside of the body. Ignore references of types 'D'
	and 'I' introduced for local cross-references.
	(Output_Local_References): new procedure to output the local
	cross-references sections.
	(Lref_Entity_Status): new array defining whether an entity is a local
	* sem_ch3.adb (Analyze_Object_Declaration): call Generate_Reference
	with 'I' type when initialization expression is present.
	* get_scos.adb, get_scos.ads: Correct comments and typos

From-SVN: r177168
parent 1f6439e3
Showing with 274 additions and 37 deletions
gcc/ada/ChangeLog
2011-08-02 Robert Dewar <dewar@adacore.com>
* sem_res.adb: Minor reformatting.
* sem_prag.adb: Minor reformatting.
2011-08-02 Javier Miranda <miranda@adacore.com>
* exp_atag.adb, exp_atags.ads
(Build_Common_Dispatching_Select_Statement): Replace argument DT_Ptr
by the tagged type Entity. Required to use this routine in the VM
targets since we do not have available the Tag entity in the VM
platforms.
* exp_ch6.adb
(Expand_N_Subprogram_Body): Do not invoke Build_VM_TSDs if package
Ada.Tags has not been previously loaded.
* exp_ch7.adb
(Expand_N_Package_Declaration, Expand_N_Package_Body): Do not invoke
Build_VM_TSDs if package Ada.Tags has not been previously loaded.
* sem_aux.adb
(Enclosing_Dynamic_Scope): Add missing support to handle the full
view of enclosing scopes. Required to handle enclosing scopes that
are synchronized types whose full view is a task type.
* exp_disp.adb
(Build_VM_TSDs): Minor code improvement to avoid generating and
analyzing lists with empty nodes.
(Make_Disp_Asynchronous_Select_Body): Add support for VM targets.
(Make_Disp_Conditional_Select_Body): Add support for VM targets.
(Make_Disp_Get_Prim_Op_Kind): Add support for VM targets.
(Make_Disp_Timed_Select_Body): Add support for VM targets.
(Make_Select_Specific_Data_Table): Add support for VM targets.
(Make_VM_TSD): Generate code to initialize the SSD structure of
the TSD.
2011-08-02 Yannick Moy <moy@adacore.com>
* lib-writ.adb (Write_ALI): when ALFA mode is set, write local
cross-references section in ALI.
* lib-xref.adb, lib-xref.ads (Xref_Entry): add components Sub
(enclosing subprogram), Slc (location of Sub) and Sun (unit number of
Sub).
(Enclosing_Subprogram_Or_Package): new function to return the enclosing
subprogram or package entity of a node
(Is_Local_Reference_Type): new function returns True for references
selected in local cross-references.
(Lt): function extracted from Lt in Output_References
(Write_Entity_Name): function extracted from Output_References
(Generate_Definition): generate reference with type 'D' for definition
of objects (object declaration and parameter specification), with
appropriate locations and units, for use in local cross-references.
(Generate_Reference): update fields Sub, Slc and Sun. Keep newly created
references of type 'I' for initialization in object definition.
(Output_References): move part of function Lt and procedure
Write_Entity_Name outside of the body. Ignore references of types 'D'
and 'I' introduced for local cross-references.
(Output_Local_References): new procedure to output the local
cross-references sections.
(Lref_Entity_Status): new array defining whether an entity is a local
* sem_ch3.adb (Analyze_Object_Declaration): call Generate_Reference
with 'I' type when initialization expression is present.
* get_scos.adb, get_scos.ads: Correct comments and typos
2011-08-02 Javier Miranda <miranda@adacore.com> 2011-08-02 Javier Miranda <miranda@adacore.com>
* exp_ch6.adb (Expand_N_Subprogram_Body): Enable generation of TSDs in * exp_ch6.adb (Expand_N_Subprogram_Body): Enable generation of TSDs in
......
gcc/ada/exp_atag.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2006-2010, Free Software Foundation, Inc. -- -- Copyright (C) 2006-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -31,6 +31,7 @@ with Exp_Util; use Exp_Util; ...@@ -31,6 +31,7 @@ with Exp_Util; use Exp_Util;
with Namet; use Namet; with Namet; use Namet;
with Nlists; use Nlists; with Nlists; use Nlists;
with Nmake; use Nmake; with Nmake; use Nmake;
with Opt; use Opt;
with Rtsfind; use Rtsfind; with Rtsfind; use Rtsfind;
with Sinfo; use Sinfo; with Sinfo; use Sinfo;
with Sem_Aux; use Sem_Aux; with Sem_Aux; use Sem_Aux;
...@@ -71,9 +72,11 @@ package body Exp_Atag is ...@@ -71,9 +72,11 @@ package body Exp_Atag is
procedure Build_Common_Dispatching_Select_Statements procedure Build_Common_Dispatching_Select_Statements
(Loc : Source_Ptr; (Loc : Source_Ptr;
DT_Ptr : Entity_Id; Typ : Entity_Id;
Stmts : List_Id) Stmts : List_Id)
is is
Tag_Node : Node_Id;
begin begin
-- Generate: -- Generate:
-- C := get_prim_op_kind (tag! (<type>VP), S); -- C := get_prim_op_kind (tag! (<type>VP), S);
...@@ -81,6 +84,19 @@ package body Exp_Atag is ...@@ -81,6 +84,19 @@ package body Exp_Atag is
-- where C is the out parameter capturing the call kind and S is the -- where C is the out parameter capturing the call kind and S is the
-- dispatch table slot number. -- dispatch table slot number.
if Tagged_Type_Expansion then
Tag_Node :=
Unchecked_Convert_To (RTE (RE_Tag),
New_Reference_To
(Node (First_Elmt (Access_Disp_Table (Typ))), Loc));
else
Tag_Node :=
Make_Attribute_Reference (Loc,
Prefix => New_Reference_To (Typ, Loc),
Attribute_Name => Name_Tag);
end if;
Append_To (Stmts, Append_To (Stmts,
Make_Assignment_Statement (Loc, Make_Assignment_Statement (Loc,
Name => Make_Identifier (Loc, Name_uC), Name => Make_Identifier (Loc, Name_uC),
...@@ -88,8 +104,7 @@ package body Exp_Atag is ...@@ -88,8 +104,7 @@ package body Exp_Atag is
Make_Function_Call (Loc, Make_Function_Call (Loc,
Name => New_Occurrence_Of (RTE (RE_Get_Prim_Op_Kind), Loc), Name => New_Occurrence_Of (RTE (RE_Get_Prim_Op_Kind), Loc),
Parameter_Associations => New_List ( Parameter_Associations => New_List (
Unchecked_Convert_To (RTE (RE_Tag), Tag_Node,
New_Reference_To (DT_Ptr, Loc)),
Make_Identifier (Loc, Name_uS))))); Make_Identifier (Loc, Name_uS)))));
-- Generate: -- Generate:
......
gcc/ada/exp_atag.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2006-2010, Free Software Foundation, Inc. -- -- Copyright (C) 2006-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -36,7 +36,7 @@ package Exp_Atag is ...@@ -36,7 +36,7 @@ package Exp_Atag is
procedure Build_Common_Dispatching_Select_Statements procedure Build_Common_Dispatching_Select_Statements
(Loc : Source_Ptr; (Loc : Source_Ptr;
DT_Ptr : Entity_Id; Typ : Entity_Id;
Stmts : List_Id); Stmts : List_Id);
-- Ada 2005 (AI-345): Generate statements that are common between timed, -- Ada 2005 (AI-345): Generate statements that are common between timed,
-- asynchronous, and conditional select expansion. -- asynchronous, and conditional select expansion.
......
gcc/ada/exp_ch6.adb
...@@ -5125,8 +5125,13 @@ package body Exp_Ch6 is ...@@ -5125,8 +5125,13 @@ package body Exp_Ch6 is
-- VM targets, we now generate the Type Specific Data record of all the -- VM targets, we now generate the Type Specific Data record of all the
-- enclosing tagged type declarations. -- enclosing tagged type declarations.
-- If the runtime package Ada_Tags has not been loaded then this
-- subprogram does not have tagged type declarations and there is no
-- need to search for tagged types to generate their TSDs.
if not Tagged_Type_Expansion if not Tagged_Type_Expansion
and then Unit (Cunit (Main_Unit)) = N and then Unit (Cunit (Main_Unit)) = N
and then RTU_Loaded (Ada_Tags)
then then
Build_VM_TSDs (N); Build_VM_TSDs (N);
end if; end if;
......
gcc/ada/exp_ch7.adb
...@@ -1560,9 +1560,17 @@ package body Exp_Ch7 is ...@@ -1560,9 +1560,17 @@ package body Exp_Ch7 is
-- we must generate the corresponding Type Specific Data record. -- we must generate the corresponding Type Specific Data record.
elsif Unit (Cunit (Main_Unit)) = N then elsif Unit (Cunit (Main_Unit)) = N then
-- If the runtime package Ada_Tags has not been loaded then
-- this package does not have tagged type declarations and
-- there is no need to search for tagged types to generate
-- their TSDs.
if RTU_Loaded (Ada_Tags) then
Build_VM_TSDs (N); Build_VM_TSDs (N);
end if; end if;
end if; end if;
end if;
Build_Task_Activation_Call (N); Build_Task_Activation_Call (N);
Pop_Scope; Pop_Scope;
...@@ -1670,9 +1678,15 @@ package body Exp_Ch7 is ...@@ -1670,9 +1678,15 @@ package body Exp_Ch7 is
elsif Unit (Cunit (Main_Unit)) = N then elsif Unit (Cunit (Main_Unit)) = N then
-- Enter the scope of the package because the new declarations are -- If the runtime package Ada_Tags has not been loaded then
-- appended at the end of the package and must be analyzed in that -- this package does not have tagged types and there is no need
-- context. -- to search for tagged types to generate their TSDs.
if RTU_Loaded (Ada_Tags) then
-- Enter the scope of the package because the new declarations
-- are appended at the end of the package and must be analyzed
-- in that context.
Push_Scope (Id); Push_Scope (Id);
...@@ -1688,6 +1702,7 @@ package body Exp_Ch7 is ...@@ -1688,6 +1702,7 @@ package body Exp_Ch7 is
Pop_Scope; Pop_Scope;
end if; end if;
end if; end if;
end if;
-- Note: it is not necessary to worry about generating a subprogram -- Note: it is not necessary to worry about generating a subprogram
-- descriptor, since the only way to get exception handlers into a -- descriptor, since the only way to get exception handlers into a
......
gcc/ada/get_scos.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2009, Free Software Foundation, Inc. -- -- Copyright (C) 2009-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
......
gcc/ada/get_scos.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2009, Free Software Foundation, Inc. -- -- Copyright (C) 2009-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -32,7 +32,7 @@ generic ...@@ -32,7 +32,7 @@ generic
with function Getc return Character is <>; with function Getc return Character is <>;
-- Get next character, positioning the ALI file ready to read the following -- Get next character, positioning the ALI file ready to read the following
-- character (equivalent to calling Skipc, then Nextc). If the end of file -- character (equivalent to calling Nextc, then Skipc). If the end of file
-- is encountered, the value Types.EOF is returned. -- is encountered, the value Types.EOF is returned.
with function Nextc return Character is <>; with function Nextc return Character is <>;
...@@ -54,5 +54,5 @@ procedure Get_SCOs; ...@@ -54,5 +54,5 @@ procedure Get_SCOs;
-- first character of the line following the SCO information (which will -- first character of the line following the SCO information (which will
-- never start with a 'C'). -- never start with a 'C').
-- --
-- If a format error is detected in the input, then an exceptions is raised -- If a format error is detected in the input, then an exception is raised
-- (Ada.IO_Exceptions.Data_Error), with the file positioned to the error. -- (Ada.IO_Exceptions.Data_Error), with the file positioned to the error.
gcc/ada/lib-writ.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -1301,6 +1301,13 @@ package body Lib.Writ is ...@@ -1301,6 +1301,13 @@ package body Lib.Writ is
SCO_Output; SCO_Output;
end if; end if;
-- Output references by subprogram
if ALFA_Mode then
Write_Info_EOL;
Output_Local_References;
end if;
-- Output final blank line and we are done. This final blank line is -- Output final blank line and we are done. This final blank line is
-- probably junk, but we don't feel like making an incompatible change! -- probably junk, but we don't feel like making an incompatible change!
......
gcc/ada/lib-xref.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1998-2010, Free Software Foundation, Inc. -- -- Copyright (C) 1998-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -44,7 +44,7 @@ package Lib.Xref is ...@@ -44,7 +44,7 @@ package Lib.Xref is
-- This header precedes xref information (entities/references from -- This header precedes xref information (entities/references from
-- the unit), identified by dependency number and file name. The -- the unit), identified by dependency number and file name. The
-- dependency number is the index into the generated D lines and -- dependency number is the index into the generated D lines and
-- is ones origin (i.e. 2 = reference to second generated D line). -- its origin is one (i.e. 2 = reference to second generated D line).
-- Note that the filename here will reflect the original name if -- Note that the filename here will reflect the original name if
-- a Source_Reference pragma was encountered (since all line number -- a Source_Reference pragma was encountered (since all line number
...@@ -69,7 +69,7 @@ package Lib.Xref is ...@@ -69,7 +69,7 @@ package Lib.Xref is
-- level is a single character that separates the col and -- level is a single character that separates the col and
-- entity fields. It is an asterisk (*) for a top level library -- entity fields. It is an asterisk (*) for a top level library
-- entity that is publicly visible, as well for an entity declared -- entity that is publicly visible, as well as for an entity declared
-- in the visible part of a generic package, the plus sign (+) for -- in the visible part of a generic package, the plus sign (+) for
-- a C/C++ static entity, and space otherwise. -- a C/C++ static entity, and space otherwise.
...@@ -172,9 +172,11 @@ package Lib.Xref is ...@@ -172,9 +172,11 @@ package Lib.Xref is
-- b = body entity -- b = body entity
-- c = completion of private or incomplete type -- c = completion of private or incomplete type
-- d = discriminant of type -- d = discriminant of type
-- D = object definition
-- e = end of spec -- e = end of spec
-- H = abstract type -- H = abstract type
-- i = implicit reference -- i = implicit reference
-- I = object definition with initialization
-- k = implicit reference to parent unit in child unit -- k = implicit reference to parent unit in child unit
-- l = label on END line -- l = label on END line
-- m = modification -- m = modification
...@@ -567,6 +569,134 @@ package Lib.Xref is ...@@ -567,6 +569,134 @@ package Lib.Xref is
-- y abstract function entry or entry family -- y abstract function entry or entry family
-- z generic formal parameter (unused) -- z generic formal parameter (unused)
-------------------------------------------------------------
-- Format of Local Cross-Reference Information in ALI File --
-------------------------------------------------------------
-- Local cross-reference sections follow the cross-reference section in an
-- ALI file, so that they need not be read by gnatbind, gnatmake etc.
-- A local cross-reference section has a header of the form
-- S line type col entity
-- These precisely define a subprogram or package, with the same
-- components as described for cross-reference sections.
-- These sections are grouped in chapters for each unit introduced by
-- F dependency-number filename
-- Each section groups a number of cross-reference sub-sections introduced
-- by
-- X dependency-number filename
-- Inside each cross-reference sub-section, there are a number of
-- references like
-- line type col entity ref ref ...
-----------------------------------
-- Local-Reference Entity Filter --
-----------------------------------
Lref_Entity_Status : array (Entity_Kind) of Boolean :=
(E_Void => False,
E_Variable => True,
E_Component => False,
E_Constant => True,
E_Discriminant => False,
E_Loop_Parameter => True,
E_In_Parameter => True,
E_Out_Parameter => True,
E_In_Out_Parameter => True,
E_Generic_In_Out_Parameter => False,
E_Generic_In_Parameter => False,
E_Named_Integer => False,
E_Named_Real => False,
E_Enumeration_Type => False,
E_Enumeration_Subtype => False,
E_Signed_Integer_Type => False,
E_Signed_Integer_Subtype => False,
E_Modular_Integer_Type => False,
E_Modular_Integer_Subtype => False,
E_Ordinary_Fixed_Point_Type => False,
E_Ordinary_Fixed_Point_Subtype => False,
E_Decimal_Fixed_Point_Type => False,
E_Decimal_Fixed_Point_Subtype => False,
E_Floating_Point_Type => False,
E_Floating_Point_Subtype => False,
E_Access_Type => False,
E_Access_Subtype => False,
E_Access_Attribute_Type => False,
E_Allocator_Type => False,
E_General_Access_Type => False,
E_Access_Subprogram_Type => False,
E_Access_Protected_Subprogram_Type => False,
E_Anonymous_Access_Subprogram_Type => False,
E_Anonymous_Access_Protected_Subprogram_Type => False,
E_Anonymous_Access_Type => False,
E_Array_Type => False,
E_Array_Subtype => False,
E_String_Type => False,
E_String_Subtype => False,
E_String_Literal_Subtype => False,
E_Class_Wide_Type => False,
E_Class_Wide_Subtype => False,
E_Record_Type => False,
E_Record_Subtype => False,
E_Record_Type_With_Private => False,
E_Record_Subtype_With_Private => False,
E_Private_Type => False,
E_Private_Subtype => False,
E_Limited_Private_Type => False,
E_Limited_Private_Subtype => False,
E_Incomplete_Type => False,
E_Incomplete_Subtype => False,
E_Task_Type => False,
E_Task_Subtype => False,
E_Protected_Type => False,
E_Protected_Subtype => False,
E_Exception_Type => False,
E_Subprogram_Type => False,
E_Enumeration_Literal => False,
E_Function => True,
E_Operator => True,
E_Procedure => True,
E_Entry => False,
E_Entry_Family => False,
E_Block => False,
E_Entry_Index_Parameter => False,
E_Exception => False,
E_Generic_Function => False,
E_Generic_Package => False,
E_Generic_Procedure => False,
E_Label => False,
E_Loop => False,
E_Return_Statement => False,
E_Package => False,
E_Package_Body => False,
E_Protected_Object => False,
E_Protected_Body => False,
E_Task_Body => False,
E_Subprogram_Body => False);
-------------------------------------- --------------------------------------
-- Handling of Imported Subprograms -- -- Handling of Imported Subprograms --
-------------------------------------- --------------------------------------
...@@ -611,17 +741,8 @@ package Lib.Xref is ...@@ -611,17 +741,8 @@ package Lib.Xref is
-- This procedure is called to record a reference. N is the location -- This procedure is called to record a reference. N is the location
-- of the reference and E is the referenced entity. Typ is one of: -- of the reference and E is the referenced entity. Typ is one of:
-- --
-- 'b' body entity -- a character already described in the description of ref entries above
-- 'c' completion of incomplete or private type (see below) -- ' ' for dummy reference (see below)
-- 'e' end of construct
-- 'i' implicit reference
-- 'l' label on end line
-- 'm' modification
-- 'p' primitive operation
-- 'r' standard reference
-- 't' end of body
-- 'x' type extension
-- ' ' dummy reference (see below)
-- --
-- Note: all references to incomplete or private types are to the -- Note: all references to incomplete or private types are to the
-- original (incomplete or private type) declaration. The full -- original (incomplete or private type) declaration. The full
...@@ -675,6 +796,9 @@ package Lib.Xref is ...@@ -675,6 +796,9 @@ package Lib.Xref is
procedure Output_References; procedure Output_References;
-- Output references to the current ali file -- Output references to the current ali file
procedure Output_Local_References;
-- Output references in each subprogram of the current ali file
procedure Initialize; procedure Initialize;
-- Initialize internal tables -- Initialize internal tables
......
gcc/ada/sem_aux.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -180,10 +180,16 @@ package body Sem_Aux is ...@@ -180,10 +180,16 @@ package body Sem_Aux is
if No (S) then if No (S) then
return Standard_Standard; return Standard_Standard;
-- Quit if we get to standard or a dynamic scope -- Quit if we get to standard or a dynamic scope. We must also
-- handle enclosing scopes that have a full view; required to
-- locate enclosing scopes that are synchronized private types
-- whose full view is a task type.
elsif S = Standard_Standard elsif S = Standard_Standard
or else Is_Dynamic_Scope (S) or else Is_Dynamic_Scope (S)
or else (Is_Private_Type (S)
and then Present (Full_View (S))
and then Is_Dynamic_Scope (Full_View (S)))
then then
return S; return S;
......
gcc/ada/sem_ch3.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -3701,6 +3701,10 @@ package body Sem_Ch3 is ...@@ -3701,6 +3701,10 @@ package body Sem_Ch3 is
if Has_Aspects (N) then if Has_Aspects (N) then
Analyze_Aspect_Specifications (N, Id); Analyze_Aspect_Specifications (N, Id);
end if; end if;
if ALFA_Mode and then Present (Expression (Original_Node (N))) then
Generate_Reference (Id, Id, 'I');
end if;
end Analyze_Object_Declaration; end Analyze_Object_Declaration;
--------------------------- ---------------------------
......
gcc/ada/sem_prag.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
......
gcc/ada/sem_res.adb
...@@ -5751,9 +5751,9 @@ package body Sem_Res is ...@@ -5751,9 +5751,9 @@ package body Sem_Res is
-- Check_Formal_Restriction ("function not inherited", N); -- Check_Formal_Restriction ("function not inherited", N);
-- end if; -- end if;
-- Implement rule in 12.5.1 (23.3/2) : in an instance, if the actual -- Implement rule in 12.5.1 (23.3/2): In an instance, if the actual is
-- is class-wide and the call dispatches on result in a context that -- class-wide and the call dispatches on result in a context that does
-- does not provide a tag, the call raises Program_Error. -- not provide a tag, the call raises Program_Error.
if Nkind (N) = N_Function_Call if Nkind (N) = N_Function_Call
and then In_Instance and then In_Instance
...@@ -5762,8 +5762,7 @@ package body Sem_Res is ...@@ -5762,8 +5762,7 @@ package body Sem_Res is
and then Has_Controlling_Result (Nam) and then Has_Controlling_Result (Nam)
and then Nkind (Parent (N)) = N_Object_Declaration and then Nkind (Parent (N)) = N_Object_Declaration
then then
-- Verify that none of the formals are controlling
-- verify that none of the formals are controlling.
declare declare
Call_OK : Boolean := False; Call_OK : Boolean := False;
...@@ -5776,6 +5775,7 @@ package body Sem_Res is ...@@ -5776,6 +5775,7 @@ package body Sem_Res is
Call_OK := True; Call_OK := True;
exit; exit;
end if; end if;
Next_Formal (F); Next_Formal (F);
end loop; end loop;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment