OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2012-02-22  Pascal Obry  <obry@adacore.com>

	* s-taprop-mingw.adb (Finalize_TCB): Do not wait on thread handle as
	this is our own thread.

2012-02-22  Sergey Rybin  <rybin@adacore.com frybin>

	* tree_io.ads: Update ASIS_Version_Number because of the changes
	in Snames.

2012-02-22  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch7.adb (Create_Finalizer): Suppress elaboration checks on 
	stack-related finalizers.

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

	* sem_ch6.adb (Analyze_Expression_Function): If the construct
	is a completion, indicate that its formals are the formals of
	a completion, and as such do not get a cross- reference entry.
	(Analyze_Subprogram_Specification): Do not generate a definition
	for the entity of an expression function, because it may be a
	completion. Definition will be generated if needed when analyzing
	the generated subprogram declaration.

2012-02-22  Vincent Celier  <celier@adacore.com>

	* make.adb (Check): When checking if an object file is in the
	correct object directory, get the unit name from a previous call
	to Check_Source_Info_In_ALI.
	* makeutl.adb (Check_Source_Info_In_ALI): Return the name of
	the unit when everything is OK, otherwise return No_Name.
	* makeutl.ads (Check_Source_Info_In_ALI): Return Name_Id instead
	of Boolean

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

	* sem_ch4.adb (Find_Equality_Types, Try_One_Interp): In an
	instance, the operator is visible if an operand is of some
	numeric type which is not in use or directly visible, and the
	other operand is a numeric literal.

2012-02-22  Tristan Gingold  <gingold@adacore.com>

	* init.c: Minor code clean up.
	* gcc-interface/Make-lang.in: Update dependencies.

2012-02-22  Arnaud Charlet  <charlet@adacore.com>

	* gnatlink.adb (Gnatlink): Use -gnatcC in CodePeer_Node,
	otherwise GCC will generate an object file.

2012-02-22  Vincent Celier  <celier@adacore.com>

	* projects.texi: Correct typo related to "**" in Source_Dirs.

From-SVN: r184477
This commit is contained in:
Arnaud Charlet 2012-02-22 15:03:25 +01:00
parent 4595863423
commit 31af889996
13 changed files with 229 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
gcc/ada/ChangeLog
View File

@ -1,3 +1,59 @@
2012-02-22 Pascal Obry <obry@adacore.com>
* s-taprop-mingw.adb (Finalize_TCB): Do not wait on thread handle as
this is our own thread.
2012-02-22 Sergey Rybin <rybin@adacore.com frybin>
* tree_io.ads: Update ASIS_Version_Number because of the changes
in Snames.
2012-02-22 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch7.adb (Create_Finalizer): Suppress elaboration checks on
stack-related finalizers.
2012-02-22 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Expression_Function): If the construct
is a completion, indicate that its formals are the formals of
a completion, and as such do not get a cross- reference entry.
(Analyze_Subprogram_Specification): Do not generate a definition
for the entity of an expression function, because it may be a
completion. Definition will be generated if needed when analyzing
the generated subprogram declaration.
2012-02-22 Vincent Celier <celier@adacore.com>
* make.adb (Check): When checking if an object file is in the
correct object directory, get the unit name from a previous call
to Check_Source_Info_In_ALI.
* makeutl.adb (Check_Source_Info_In_ALI): Return the name of
the unit when everything is OK, otherwise return No_Name.
* makeutl.ads (Check_Source_Info_In_ALI): Return Name_Id instead
of Boolean
2012-02-22 Ed Schonberg <schonberg@adacore.com>
* sem_ch4.adb (Find_Equality_Types, Try_One_Interp): In an
instance, the operator is visible if an operand is of some
numeric type which is not in use or directly visible, and the
other operand is a numeric literal.
2012-02-22 Tristan Gingold <gingold@adacore.com>
* init.c: Minor code clean up.
* gcc-interface/Make-lang.in: Update dependencies.
2012-02-22 Arnaud Charlet <charlet@adacore.com>
* gnatlink.adb (Gnatlink): Use -gnatcC in CodePeer_Node,
otherwise GCC will generate an object file.
2012-02-22 Vincent Celier <celier@adacore.com>
* projects.texi: Correct typo related to "**" in Source_Dirs.
2012-02-22 Steve Baird <baird@adacore.com>
* sem_prag.adb (Analyze_PPC_In_Decl_Part): Clean up generation of

31
gcc/ada/exp_ch7.adb
View File

@ -1372,6 +1372,37 @@ package body Exp_Ch7 is
Fin_Id :=
Make_Defining_Identifier (Loc,
Chars => New_External_Name (Name_uFinalizer));
-- The visibility semantics of AT_END handlers force a strange
-- separation of spec and body for stack-related finalizers:
-- declare : Enclosing_Scope
-- procedure _finalizer;
-- begin
-- <controlled objects>
-- procedure _finalizer is
-- ...
-- at end
-- _finalizer;
-- end;
-- Both spec and body are within the same construct and scope, but
-- the body is part of the handled sequence of statements. This
-- placement confuses the elaboration mechanism on targets where
-- AT_END handlers are expanded into "when all others" handlers:
-- exception
-- when all others =>
-- _finalizer; -- appears to require elab checks
-- at end
-- _finalizer;
-- end;
-- Since the compiler guarantees that the body of a _finalizer is
-- always inserted in the same construct where the AT_END handler
-- resides, there is no need for elaboration checks.
Set_Kill_Elaboration_Checks (Fin_Id);
end if;
-- Step 2: Creation of the finalizer specification

74
gcc/ada/gcc-interface/Make-lang.in
View File

@ -2079,19 +2079,20 @@ ada/exp_ch5.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/checks.ads ada/checks.adb \
ada/csets.ads ada/debug.ads ada/debug_a.ads ada/einfo.ads ada/einfo.adb \
ada/elists.ads ada/err_vars.ads ada/errout.ads ada/erroutc.ads \
ada/eval_fat.ads ada/exp_aggr.ads ada/exp_ch11.ads ada/exp_ch2.ads \
ada/exp_ch4.ads ada/exp_ch5.ads ada/exp_ch5.adb ada/exp_ch6.ads \
ada/exp_ch7.ads ada/exp_dbug.ads ada/exp_disp.ads ada/exp_pakd.ads \
ada/exp_tss.ads ada/exp_util.ads ada/exp_util.adb ada/expander.ads \
ada/fname.ads ada/fname-uf.ads ada/freeze.ads ada/get_targ.ads \
ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads ada/hlo.ads \
ada/hostparm.ads ada/inline.ads ada/interfac.ads ada/itypes.ads \
ada/lib.ads ada/lib-load.ads ada/lib-util.ads ada/lib-xref.ads \
ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
ada/nmake.adb ada/opt.ads ada/output.ads ada/put_alfa.ads \
ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \
ada/scans.ads ada/sem.ads ada/sem.adb ada/sem_attr.ads ada/sem_aux.ads \
ada/elists.ads ada/err_vars.ads ada/errout.ads ada/errout.adb \
ada/erroutc.ads ada/erroutc.adb ada/eval_fat.ads ada/exp_aggr.ads \
ada/exp_ch11.ads ada/exp_ch2.ads ada/exp_ch4.ads ada/exp_ch5.ads \
ada/exp_ch5.adb ada/exp_ch6.ads ada/exp_ch7.ads ada/exp_dbug.ads \
ada/exp_disp.ads ada/exp_pakd.ads ada/exp_tss.ads ada/exp_util.ads \
ada/exp_util.adb ada/expander.ads ada/fname.ads ada/fname-uf.ads \
ada/freeze.ads ada/get_targ.ads ada/gnat.ads ada/g-hesorg.ads \
ada/g-htable.ads ada/gnatvsn.ads ada/hlo.ads ada/hostparm.ads \
ada/inline.ads ada/interfac.ads ada/itypes.ads ada/lib.ads \
ada/lib-load.ads ada/lib-util.ads ada/lib-xref.ads ada/namet.ads \
ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
ada/opt.ads ada/output.ads ada/put_alfa.ads ada/restrict.ads \
ada/restrict.adb ada/rident.ads ada/rtsfind.ads ada/scans.ads \
ada/sem.ads ada/sem.adb ada/sem_attr.ads ada/sem_aux.ads \
ada/sem_aux.adb ada/sem_cat.ads ada/sem_ch10.ads ada/sem_ch11.ads \
ada/sem_ch12.ads ada/sem_ch13.ads ada/sem_ch13.adb ada/sem_ch2.ads \
ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads ada/sem_ch6.ads \
@ -4338,29 +4339,30 @@ ada/sem_dim.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads \
ada/debug_a.ads ada/einfo.ads ada/einfo.adb ada/elists.ads \
ada/err_vars.ads ada/errout.ads ada/errout.adb ada/erroutc.ads \
ada/erroutc.adb ada/exp_tss.ads ada/expander.ads ada/fname.ads \
ada/gnat.ads ada/g-hesorg.ads ada/g-htable.ads ada/gnatvsn.ads \
ada/hlo.ads ada/hostparm.ads ada/inline.ads ada/interfac.ads \
ada/lib.ads ada/lib.adb ada/lib-list.adb ada/lib-load.ads \
ada/lib-sort.adb ada/namet.ads ada/namet.adb ada/nlists.ads \
ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \
ada/sem.ads ada/sem.adb ada/sem_attr.ads ada/sem_aux.ads \
ada/sem_ch10.ads ada/sem_ch11.ads ada/sem_ch12.ads ada/sem_ch13.ads \
ada/sem_ch2.ads ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch5.ads \
ada/sem_ch6.ads ada/sem_ch7.ads ada/sem_ch8.ads ada/sem_ch9.ads \
ada/sem_dim.ads ada/sem_dim.adb ada/sem_eval.ads ada/sem_prag.ads \
ada/sem_res.ads ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb \
ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
ada/stringt.adb ada/stylesw.ads ada/system.ads ada/s-exctab.ads \
ada/s-htable.ads ada/s-htable.adb ada/s-imenne.ads ada/s-memory.ads \
ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads \
ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
ada/s-stoele.adb ada/s-strhas.ads ada/s-string.ads ada/s-traent.ads \
ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
ada/targparm.ads ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads \
ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/erroutc.adb ada/exp_dist.ads ada/exp_tss.ads ada/expander.ads \
ada/fname.ads ada/fname-uf.ads ada/gnat.ads ada/g-hesorg.ads \
ada/g-htable.ads ada/gnatvsn.ads ada/hlo.ads ada/hostparm.ads \
ada/inline.ads ada/interfac.ads ada/lib.ads ada/lib.adb \
ada/lib-list.adb ada/lib-load.ads ada/lib-sort.adb ada/namet.ads \
ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads ada/nmake.adb \
ada/opt.ads ada/output.ads ada/restrict.ads ada/rident.ads \
ada/rtsfind.ads ada/rtsfind.adb ada/scans.ads ada/sem.ads ada/sem.adb \
ada/sem_attr.ads ada/sem_aux.ads ada/sem_ch10.ads ada/sem_ch11.ads \
ada/sem_ch12.ads ada/sem_ch13.ads ada/sem_ch2.ads ada/sem_ch3.ads \
ada/sem_ch4.ads ada/sem_ch5.ads ada/sem_ch6.ads ada/sem_ch7.ads \
ada/sem_ch8.ads ada/sem_ch9.ads ada/sem_dim.ads ada/sem_dim.adb \
ada/sem_dist.ads ada/sem_eval.ads ada/sem_prag.ads ada/sem_res.ads \
ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
ada/snames.ads ada/stand.ads ada/stringt.ads ada/stringt.adb \
ada/stylesw.ads ada/system.ads ada/s-exctab.ads ada/s-htable.ads \
ada/s-htable.adb ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
ada/s-strhas.ads ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/types.ads \
ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/sem_disp.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \

6
gcc/ada/gnatlink.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1996-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1996-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- --
@ -1653,7 +1653,7 @@ begin
-- because bindgen uses brackets encoding for all upper
-- half and wide characters in identifier names.
-- In addition, in CodePeer mode compile with -gnatC
-- In addition, in CodePeer mode compile with -gnatcC
Binder_Options_From_ALI.Increment_Last;
Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
@ -1668,7 +1668,7 @@ begin
if Opt.CodePeer_Mode then
Binder_Options_From_ALI.Increment_Last;
Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) :=
new String'("-gnatC");
new String'("-gnatcC");
end if;
-- Locate all the necessary programs and verify required files are present

5
gcc/ada/init.c
View File

@ -1239,8 +1239,6 @@ static const struct cond_except dec_ada_cond_except_table [] = {
{ADA$_KEY_MISMATCH, &Use_Error},
{ADA$_MAXLINEXC, &constraint_error},
{ADA$_LINEXCMRS, &constraint_error},
{0, 0}
};
#if 0
/* Already handled by a pragma Import_Exception
@ -1250,6 +1248,9 @@ static const struct cond_except dec_ada_cond_except_table [] = {
{ADA$_KEY_ERROR, &Key_Error},
#endif
{0, 0}
};
#endif /* IN_RTS */
/* Non-DEC Ada specific conditions. We could probably also put

50
gcc/ada/make.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- --
@ -1863,44 +1863,44 @@ package body Make is
end if;
elsif not Read_Only and then Main_Project /= No_Project then
if not Check_Source_Info_In_ALI (ALI, Project_Tree) then
ALI := No_ALI_Id;
return;
end if;
-- Check that the ALI file is in the correct object directory.
-- If it is in the object directory of a project that is
-- extended and it depends on a source that is in one of its
-- extending projects, then the ALI file is not in the correct
-- object directory.
-- First, find the project of this ALI file. As there may be
-- several projects with the same object directory, we first
-- need to find the project of the source.
ALI_Project := No_Project;
declare
Uname : constant Name_Id :=
Check_Source_Info_In_ALI (ALI, Project_Tree);
Udata : Prj.Unit_Index;
begin
Udata := Units_Htable.Get_First (Project_Tree.Units_HT);
while Udata /= No_Unit_Index loop
if Uname = No_Name then
ALI := No_ALI_Id;
return;
end if;
-- Check that the ALI file is in the correct object
-- directory. If it is in the object directory of a project
-- that is extended and it depends on a source that is in
-- one of its extending projects, then the ALI file is not
-- in the correct object directory.
-- First, find the project of this ALI file. As there may be
-- several projects with the same object directory, we first
-- need to find the project of the source.
ALI_Project := No_Project;
Udata := Units_Htable.Get (Project_Tree.Units_HT, Uname);
if Udata /= No_Unit_Index then
if Udata.File_Names (Impl) /= null
and then Udata.File_Names (Impl).File = Source_File
then
ALI_Project := Udata.File_Names (Impl).Project;
exit;
elsif Udata.File_Names (Spec) /= null
and then Udata.File_Names (Spec).File = Source_File
then
ALI_Project := Udata.File_Names (Spec).Project;
exit;
end if;
Udata := Units_Htable.Get_Next (Project_Tree.Units_HT);
end loop;
end if;
end;
if ALI_Project = No_Project then

17
gcc/ada/makeutl.adb
View File

@ -186,8 +186,9 @@ package body Makeutl is
function Check_Source_Info_In_ALI
(The_ALI : ALI_Id;
Tree : Project_Tree_Ref) return Boolean
Tree : Project_Tree_Ref) return Name_Id
is
Result : Name_Id := No_Name;
Unit_Name : Name_Id;
begin
@ -203,7 +204,11 @@ package body Makeutl is
Unit_Name := Name_Find;
if File_Not_A_Source_Of (Tree, Unit_Name, Units.Table (U).Sfile) then
return False;
return No_Name;
end if;
if Result = No_Name then
Result := Unit_Name;
end if;
-- Loop to do same check for each of the withed units
@ -219,7 +224,7 @@ package body Makeutl is
Unit_Name := Name_Find;
if File_Not_A_Source_Of (Tree, Unit_Name, WR.Sfile) then
return False;
return No_Name;
end if;
end if;
end;
@ -258,7 +263,7 @@ package body Makeutl is
Get_Name_String (Replacement));
end if;
return False;
return No_Name;
end if;
end;
end if;
@ -294,14 +299,14 @@ package body Makeutl is
& " parsing the project. Will recompile");
end if;
return False;
return No_Name;
end if;
end if;
end if;
end;
end loop;
return True;
return Result;
end Check_Source_Info_In_ALI;
--------------------------------

8
gcc/ada/makeutl.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2004-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- --
@ -123,10 +123,10 @@ package Makeutl is
function Check_Source_Info_In_ALI
(The_ALI : ALI.ALI_Id;
Tree : Project_Tree_Ref) return Boolean;
Tree : Project_Tree_Ref) return Name_Id;
-- Check whether all file references in ALI are still valid (i.e. the
-- source files are still associated with the same units). Return True
-- if everything is still valid.
-- source files are still associated with the same units). Return the name
-- of the unit if everything is still valid. Return No_Name otherwise.
function Is_Subunit (Source : Source_Id) return Boolean;
-- Return True if source is a subunit

8
gcc/ada/projects.texi
View File

@ -403,12 +403,12 @@ If the order of the source directories is known statically, that is if
be several files with the same source file name sitting in different
directories of the project. In this case, only the file in the first directory
is considered as a source of the project and the others are hidden. If
@code{"**"} is not used in the string list @code{Source_Dirs}, it is an error
@code{"**"} is used in the string list @code{Source_Dirs}, it is an error
to have several files with the same source file name in the same directory
@code{"**"} subtree, since there would be an ambiguity as to which one should
be used. However, two files with the same source file name may in two single
directories or directory subtrees. In this case, the one in the first directory
or directory subtree is a source of the project.
be used. However, two files with the same source file name may exist in two
single directories or directory subtrees. In this case, the one in the first
directory or directory subtree is a source of the project.
@c ---------------------------------------------
@node Object and Exec Directory

21
gcc/ada/s-taprop-mingw.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. --
-- --
-- GNARL 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- --
@ -41,13 +41,13 @@ pragma Polling (Off);
with Interfaces.C;
with Interfaces.C.Strings;
with System.Float_Control;
with System.Interrupt_Management;
with System.Multiprocessors;
with System.Tasking.Debug;
with System.OS_Primitives;
with System.Task_Info;
with System.Interrupt_Management;
with System.Tasking.Debug;
with System.Win32.Ext;
with System.Float_Control;
with System.Soft_Links;
-- We use System.Soft_Links instead of System.Tasking.Initialization because
@ -59,14 +59,14 @@ package body System.Task_Primitives.Operations is
package SSL renames System.Soft_Links;
use System.Tasking.Debug;
use System.Tasking;
use Interfaces.C;
use Interfaces.C.Strings;
use System.OS_Interface;
use System.Parameters;
use System.OS_Primitives;
use System.Parameters;
use System.Task_Info;
use System.Tasking;
use System.Tasking.Debug;
use System.Win32;
use System.Win32.Ext;
@ -979,7 +979,6 @@ package body System.Task_Primitives.Operations is
------------------
procedure Finalize_TCB (T : Task_Id) is
Result : DWORD;
Succeeded : BOOL;
begin
@ -995,11 +994,9 @@ package body System.Task_Primitives.Operations is
if T.Common.LL.Thread /= 0 then
-- This task has been activated. Wait for the thread to terminate
-- then close it. This is needed to release system resources.
-- This task has been activated. Close the thread handle. This
-- is needed to release system resources.
Result := WaitForSingleObject (T.Common.LL.Thread, Wait_Infinite);
pragma Assert (Result /= WAIT_FAILED);
Succeeded := CloseHandle (T.Common.LL.Thread);
pragma Assert (Succeeded = Win32.TRUE);
end if;

11
gcc/ada/sem_ch4.adb
View File

@ -5545,7 +5545,9 @@ package body Sem_Ch4 is
-- If we have infix notation, the operator must be usable.
-- Within an instance, if the type is already established we
-- know it is correct.
-- know it is correct. If an operand is universal it is compatible
-- with any numeric type.
-- In Ada 2005, the equality on anonymous access types is declared
-- in Standard, and is always visible.
@ -5554,8 +5556,13 @@ package body Sem_Ch4 is
or else In_Use (Bas)
or else (In_Use (Scope (Bas))
and then not Is_Hidden (Bas))
or else (In_Instance
and then First_Subtype (T1) = First_Subtype (Etype (R)))
and then
(First_Subtype (T1) = First_Subtype (Etype (R))
or else (Is_Numeric_Type (T1)
and then Is_Universal_Numeric_Type (Etype (R)))))
or else Ekind (T1) = E_Anonymous_Access_Type
then
null;

37
gcc/ada/sem_ch6.adb
View File

@ -273,7 +273,6 @@ package body Sem_Ch6 is
Spec : constant Node_Id := Specification (N);
Def_Id : Entity_Id;
pragma Unreferenced (Def_Id);
Prev : Entity_Id;
-- If the expression is a completion, Prev is the entity whose
@ -371,6 +370,26 @@ package body Sem_Ch6 is
if Has_Completion (Prev) then
Set_Is_Inlined (Prev);
-- The formals of the expression function are body formals,
-- and do not appear in the ali file, which will only contain
-- references to the formals of the original subprogram spec.
declare
F1 : Entity_Id;
F2 : Entity_Id;
begin
F1 := First_Formal (Def_Id);
F2 := First_Formal (Prev);
while Present (F1) loop
Set_Spec_Entity (F1, F2);
Next_Formal (F1);
Next_Formal (F2);
end loop;
end;
else
Set_Is_Inlined (Defining_Entity (New_Body));
end if;
@ -3198,8 +3217,12 @@ package body Sem_Ch6 is
end if;
Designator := Analyze_Subprogram_Specification (Specification (N));
-- A reference may already have been generated for the unit name, in
-- which case the following call is redundant. However it is needed for
-- declarations that are the rewriting of an expression function.
Generate_Definition (Designator);
-- ??? why this call, already in Analyze_Subprogram_Specification
if Debug_Flag_C then
Write_Str ("==> subprogram spec ");
@ -3399,9 +3422,15 @@ package body Sem_Ch6 is
Check_SPARK_Restriction ("user-defined operator is not allowed", N);
end if;
-- Proceed with analysis
-- Proceed with analysis. Do not emit a cross-reference entry if the
-- specification comes from an expression function, because it may be
-- the completion of a previous declaration. It is is not, the cross-
-- reference entry will be emitted for the new subprogram declaration.
if Nkind (Parent (N)) /= N_Expression_Function then
Generate_Definition (Designator);
end if;
Generate_Definition (Designator);
Set_Contract (Designator, Make_Contract (Sloc (Designator)));
if Nkind (N) = N_Function_Specification then

5
gcc/ada/tree_io.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- --
@ -47,7 +47,7 @@ package Tree_IO is
Tree_Format_Error : exception;
-- Raised if a format error is detected in the input file
ASIS_Version_Number : constant := 27;
ASIS_Version_Number : constant := 28;
-- ASIS Version. This is used to check for consistency between the compiler
-- used to generate trees and an ASIS application that is reading the
-- trees. It must be incremented whenever a change is made to the tree
@ -55,6 +55,7 @@ package Tree_IO is
-- older version of ASIS.
--
-- 27 Changes in the tree structures for expression functions
-- 28 Changes in Snames
procedure Tree_Read_Initialize (Desc : File_Descriptor);
-- Called to initialize reading of a tree file. This call must be made