[multiple changes]
2011-08-03 Gary Dismukes <dismukes@adacore.com> * sem_ch6.adb (Find_Corresponding_Spec): When in an instance, skip conforming subprogram renamings that appear to be completions if they are not fully conformant. Such renamings are homographs but not completions. * sem_type.adb (Disambiguate): Handle disambiguation of overloaded names in a subprogram renaming that appears in an instance. 2011-08-03 Ed Schonberg <schonberg@adacore.com> * exp_util.adb (Expand_Subtype_From_Expr): if the type is limited but not immutably limited, build actual subtype from expression to provide proper bounds to caller. 2011-08-03 Gary Dismukes <dismukes@adacore.com> * sem_ch8.adb: Minor comment correction. 2011-08-03 Thomas Quinot <quinot@adacore.com> * exp_strm.adb (Build_Array_Input_Function): In Ada 2005 mode, when returning a limited array, use an extended return statement. 2011-08-03 Vincent Celier <celier@adacore.com> * make.adb (Initialize): If --subdirs= is used, but no project file is specified, attempt to create the specify subdir if it does not already exist and use it as the object directory as if -D had been specified. 2011-08-03 Arnaud Charlet <charlet@adacore.com> * s-tpopsp-vms.adb: New file. * s-taprop-vms.adb: Put back ATCB_Key, since needed by this file on VMS. * gcc-interfaces/Makefile.in: Use s-taprop-vms.adb on VMS. From-SVN: r177266
This commit is contained in:
parent
e0b23d9fd3
commit
0187b60e16
|
@ -1,3 +1,39 @@
|
||||||
|
2011-08-03 Gary Dismukes <dismukes@adacore.com>
|
||||||
|
|
||||||
|
* sem_ch6.adb (Find_Corresponding_Spec): When in an instance, skip
|
||||||
|
conforming subprogram renamings that appear to be completions if they
|
||||||
|
are not fully conformant.
|
||||||
|
Such renamings are homographs but not completions.
|
||||||
|
* sem_type.adb (Disambiguate): Handle disambiguation of overloaded
|
||||||
|
names in a subprogram renaming that appears in an instance.
|
||||||
|
|
||||||
|
2011-08-03 Ed Schonberg <schonberg@adacore.com>
|
||||||
|
|
||||||
|
* exp_util.adb (Expand_Subtype_From_Expr): if the type is limited but
|
||||||
|
not immutably limited, build actual subtype from expression to provide
|
||||||
|
proper bounds to caller.
|
||||||
|
|
||||||
|
2011-08-03 Gary Dismukes <dismukes@adacore.com>
|
||||||
|
|
||||||
|
* sem_ch8.adb: Minor comment correction.
|
||||||
|
|
||||||
|
2011-08-03 Thomas Quinot <quinot@adacore.com>
|
||||||
|
|
||||||
|
* exp_strm.adb (Build_Array_Input_Function): In Ada 2005 mode, when
|
||||||
|
returning a limited array, use an extended return statement.
|
||||||
|
|
||||||
|
2011-08-03 Vincent Celier <celier@adacore.com>
|
||||||
|
|
||||||
|
* make.adb (Initialize): If --subdirs= is used, but no project file is
|
||||||
|
specified, attempt to create the specify subdir if it does not already
|
||||||
|
exist and use it as the object directory as if -D had been specified.
|
||||||
|
|
||||||
|
2011-08-03 Arnaud Charlet <charlet@adacore.com>
|
||||||
|
|
||||||
|
* s-tpopsp-vms.adb: New file.
|
||||||
|
* s-taprop-vms.adb: Put back ATCB_Key, since needed by this file on VMS.
|
||||||
|
* gcc-interfaces/Makefile.in: Use s-taprop-vms.adb on VMS.
|
||||||
|
|
||||||
2011-08-03 Emmanuel Briot <briot@adacore.com>
|
2011-08-03 Emmanuel Briot <briot@adacore.com>
|
||||||
|
|
||||||
* make.adb, makeutl.adb, makeutl.ads, clean.adb (Makeutl.Queue): new
|
* make.adb, makeutl.adb, makeutl.ads, clean.adb (Makeutl.Queue): new
|
||||||
|
|
|
@ -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- --
|
||||||
|
@ -149,7 +149,9 @@ package body Exp_Strm is
|
||||||
Decls : List_Id;
|
Decls : List_Id;
|
||||||
Ranges : List_Id;
|
Ranges : List_Id;
|
||||||
Stms : List_Id;
|
Stms : List_Id;
|
||||||
|
Rstmt : Node_Id;
|
||||||
Indx : Node_Id;
|
Indx : Node_Id;
|
||||||
|
Odecl : Node_Id;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Decls := New_List;
|
Decls := New_List;
|
||||||
|
@ -197,13 +199,13 @@ package body Exp_Strm is
|
||||||
-- build a subtype indication with the proper bounds.
|
-- build a subtype indication with the proper bounds.
|
||||||
|
|
||||||
if Is_Constrained (Stream_Base_Type (Typ)) then
|
if Is_Constrained (Stream_Base_Type (Typ)) then
|
||||||
Append_To (Decls,
|
Odecl :=
|
||||||
Make_Object_Declaration (Loc,
|
Make_Object_Declaration (Loc,
|
||||||
Defining_Identifier => Make_Defining_Identifier (Loc, Name_V),
|
Defining_Identifier => Make_Defining_Identifier (Loc, Name_V),
|
||||||
Object_Definition =>
|
Object_Definition =>
|
||||||
New_Occurrence_Of (Stream_Base_Type (Typ), Loc)));
|
New_Occurrence_Of (Stream_Base_Type (Typ), Loc));
|
||||||
else
|
else
|
||||||
Append_To (Decls,
|
Odecl :=
|
||||||
Make_Object_Declaration (Loc,
|
Make_Object_Declaration (Loc,
|
||||||
Defining_Identifier => Make_Defining_Identifier (Loc, Name_V),
|
Defining_Identifier => Make_Defining_Identifier (Loc, Name_V),
|
||||||
Object_Definition =>
|
Object_Definition =>
|
||||||
|
@ -212,19 +214,34 @@ package body Exp_Strm is
|
||||||
New_Occurrence_Of (Stream_Base_Type (Typ), Loc),
|
New_Occurrence_Of (Stream_Base_Type (Typ), Loc),
|
||||||
Constraint =>
|
Constraint =>
|
||||||
Make_Index_Or_Discriminant_Constraint (Loc,
|
Make_Index_Or_Discriminant_Constraint (Loc,
|
||||||
Constraints => Ranges))));
|
Constraints => Ranges)));
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Stms := New_List (
|
Rstmt := Make_Attribute_Reference (Loc,
|
||||||
Make_Attribute_Reference (Loc,
|
|
||||||
Prefix => New_Occurrence_Of (Typ, Loc),
|
Prefix => New_Occurrence_Of (Typ, Loc),
|
||||||
Attribute_Name => Name_Read,
|
Attribute_Name => Name_Read,
|
||||||
Expressions => New_List (
|
Expressions => New_List (
|
||||||
Make_Identifier (Loc, Name_S),
|
Make_Identifier (Loc, Name_S),
|
||||||
Make_Identifier (Loc, Name_V))),
|
Make_Identifier (Loc, Name_V)));
|
||||||
|
|
||||||
|
if Ada_Version >= Ada_2005 then
|
||||||
|
Stms := New_List (
|
||||||
|
Make_Extended_Return_Statement (Loc,
|
||||||
|
Return_Object_Declarations => New_List (Odecl),
|
||||||
|
Handled_Statement_Sequence =>
|
||||||
|
Make_Handled_Sequence_Of_Statements (Loc,
|
||||||
|
New_List (Rstmt))));
|
||||||
|
else
|
||||||
|
-- pragma Assert (not Is_Limited_Type (Typ));
|
||||||
|
-- Returning a local object, shouldn't happen in the case of a
|
||||||
|
-- limited type, but currently occurs in DSA stubs in Ada 95 mode???
|
||||||
|
|
||||||
|
Stms := New_List (
|
||||||
|
Odecl,
|
||||||
|
Rstmt,
|
||||||
Make_Simple_Return_Statement (Loc,
|
Make_Simple_Return_Statement (Loc,
|
||||||
Expression => Make_Identifier (Loc, Name_V)));
|
Expression => Make_Identifier (Loc, Name_V)));
|
||||||
|
end if;
|
||||||
|
|
||||||
Fnam :=
|
Fnam :=
|
||||||
Make_Defining_Identifier (Loc,
|
Make_Defining_Identifier (Loc,
|
||||||
|
|
|
@ -1371,8 +1371,11 @@ package body Exp_Util is
|
||||||
|
|
||||||
-- If the type is class-wide, the expression is dynamically tagged and
|
-- If the type is class-wide, the expression is dynamically tagged and
|
||||||
-- we do not create an actual subtype either. Ditto for an interface.
|
-- we do not create an actual subtype either. Ditto for an interface.
|
||||||
|
-- For now this applies only if the type is immutably limited, and the
|
||||||
|
-- function being called is build-in-place. This will have to be revised
|
||||||
|
-- when build-in-place functions are generalized to other types.
|
||||||
|
|
||||||
elsif Is_Limited_Type (Exp_Typ)
|
elsif Is_Immutably_Limited_Type (Exp_Typ)
|
||||||
and then
|
and then
|
||||||
(Is_Class_Wide_Type (Exp_Typ)
|
(Is_Class_Wide_Type (Exp_Typ)
|
||||||
or else Is_Interface (Exp_Typ)
|
or else Is_Interface (Exp_Typ)
|
||||||
|
|
|
@ -1520,7 +1520,7 @@ ifeq ($(strip $(filter-out alpha64 ia64 dec hp vms% openvms% alphavms%,$(targ)))
|
||||||
s-taprop.adb<s-taprop-vms.adb \
|
s-taprop.adb<s-taprop-vms.adb \
|
||||||
s-tasdeb.adb<s-tasdeb-vms.adb \
|
s-tasdeb.adb<s-tasdeb-vms.adb \
|
||||||
s-taspri.ads<s-taspri-vms.ads \
|
s-taspri.ads<s-taspri-vms.ads \
|
||||||
s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
|
s-tpopsp.adb<s-tpopsp-vms.adb \
|
||||||
s-tpopde.adb<s-tpopde-vms.adb \
|
s-tpopde.adb<s-tpopde-vms.adb \
|
||||||
s-tpopde.ads<s-tpopde-vms.ads
|
s-tpopde.ads<s-tpopde-vms.ads
|
||||||
|
|
||||||
|
|
|
@ -61,17 +61,18 @@ pragma Warnings (On);
|
||||||
|
|
||||||
with Switch; use Switch;
|
with Switch; use Switch;
|
||||||
with Switch.M; use Switch.M;
|
with Switch.M; use Switch.M;
|
||||||
with Targparm; use Targparm;
|
|
||||||
with Table;
|
with Table;
|
||||||
|
with Targparm; use Targparm;
|
||||||
with Tempdir;
|
with Tempdir;
|
||||||
with Types; use Types;
|
with Types; use Types;
|
||||||
|
|
||||||
with Ada.Exceptions; use Ada.Exceptions;
|
|
||||||
with Ada.Command_Line; use Ada.Command_Line;
|
with Ada.Command_Line; use Ada.Command_Line;
|
||||||
|
with Ada.Directories;
|
||||||
|
with Ada.Exceptions; use Ada.Exceptions;
|
||||||
|
|
||||||
|
with GNAT.Case_Util; use GNAT.Case_Util;
|
||||||
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
|
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
|
||||||
with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables;
|
with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables;
|
||||||
with GNAT.Case_Util; use GNAT.Case_Util;
|
|
||||||
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
with GNAT.OS_Lib; use GNAT.OS_Lib;
|
||||||
|
|
||||||
package body Make is
|
package body Make is
|
||||||
|
@ -5898,6 +5899,10 @@ package body Make is
|
||||||
|
|
||||||
Prj.Env.Set_Ada_Paths
|
Prj.Env.Set_Ada_Paths
|
||||||
(Main_Project, Project_Tree, Use_Include_Path_File);
|
(Main_Project, Project_Tree, Use_Include_Path_File);
|
||||||
|
-- (Project => Main_Project,
|
||||||
|
-- In_Tree => Project_Tree,
|
||||||
|
-- Including_Libraries => True,
|
||||||
|
-- Include_Path => Use_Include_Path_File);
|
||||||
|
|
||||||
-- If switch -C was specified, create a binder mapping file
|
-- If switch -C was specified, create a binder mapping file
|
||||||
|
|
||||||
|
@ -6729,6 +6734,38 @@ package body Make is
|
||||||
Make_Failed ("-i and -D cannot be used simultaneously");
|
Make_Failed ("-i and -D cannot be used simultaneously");
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
-- If --subdirs= is specified, but not -P, this is equivalent to -D,
|
||||||
|
-- except that the directory is created if it does not exist.
|
||||||
|
|
||||||
|
if Prj.Subdirs /= null and then Project_File_Name = null then
|
||||||
|
if Object_Directory_Path /= null then
|
||||||
|
Make_Failed ("--subdirs and -D cannot be used simultaneously");
|
||||||
|
|
||||||
|
elsif In_Place_Mode then
|
||||||
|
Make_Failed ("--subdirs and -i cannot be used simultaneously");
|
||||||
|
|
||||||
|
else
|
||||||
|
if not Is_Directory (Prj.Subdirs.all) then
|
||||||
|
begin
|
||||||
|
Ada.Directories.Create_Path (Prj.Subdirs.all);
|
||||||
|
exception
|
||||||
|
when others =>
|
||||||
|
Make_Failed ("unable to create object directory " &
|
||||||
|
Prj.Subdirs.all);
|
||||||
|
end;
|
||||||
|
end if;
|
||||||
|
|
||||||
|
Object_Directory_Present := True;
|
||||||
|
|
||||||
|
declare
|
||||||
|
Argv : constant String (1 .. Prj.Subdirs'Length) :=
|
||||||
|
Prj.Subdirs.all;
|
||||||
|
begin
|
||||||
|
Scan_Make_Arg (Env, Argv, And_Save => False);
|
||||||
|
end;
|
||||||
|
end if;
|
||||||
|
end if;
|
||||||
|
|
||||||
-- Deal with -C= switch
|
-- Deal with -C= switch
|
||||||
|
|
||||||
if Gnatmake_Mapping_File /= null then
|
if Gnatmake_Mapping_File /= null then
|
||||||
|
|
|
@ -72,6 +72,9 @@ package body System.Task_Primitives.Operations is
|
||||||
-- a time; it is used to execute in mutual exclusion from all other tasks.
|
-- a time; it is used to execute in mutual exclusion from all other tasks.
|
||||||
-- Used mainly in Single_Lock mode, but also to protect All_Tasks_List
|
-- Used mainly in Single_Lock mode, but also to protect All_Tasks_List
|
||||||
|
|
||||||
|
ATCB_Key : aliased pthread_key_t;
|
||||||
|
-- Key used to find the Ada Task_Id associated with a thread
|
||||||
|
|
||||||
Environment_Task_Id : Task_Id;
|
Environment_Task_Id : Task_Id;
|
||||||
-- A variable to hold Task_Id for the environment task
|
-- A variable to hold Task_Id for the environment task
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,103 @@
|
||||||
|
------------------------------------------------------------------------------
|
||||||
|
-- --
|
||||||
|
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
|
||||||
|
-- --
|
||||||
|
-- SYSTEM.TASK_PRIMITIVES.OPERATIONS.SPECIFIC --
|
||||||
|
-- --
|
||||||
|
-- B o d y --
|
||||||
|
-- --
|
||||||
|
-- Copyright (C) 1992-2011, 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- --
|
||||||
|
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
||||||
|
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
||||||
|
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
||||||
|
-- or FITNESS FOR A PARTICULAR PURPOSE. --
|
||||||
|
-- --
|
||||||
|
-- As a special exception under Section 7 of GPL version 3, you are granted --
|
||||||
|
-- additional permissions described in the GCC Runtime Library Exception, --
|
||||||
|
-- version 3.1, as published by the Free Software Foundation. --
|
||||||
|
-- --
|
||||||
|
-- You should have received a copy of the GNU General Public License and --
|
||||||
|
-- a copy of the GCC Runtime Library Exception along with this program; --
|
||||||
|
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
||||||
|
-- <http://www.gnu.org/licenses/>. --
|
||||||
|
-- --
|
||||||
|
-- GNARL was developed by the GNARL team at Florida State University. --
|
||||||
|
-- Extensive contributions were provided by Ada Core Technologies, Inc. --
|
||||||
|
-- --
|
||||||
|
------------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- This is a VMS version of this package where foreign threads are
|
||||||
|
-- recognized.
|
||||||
|
|
||||||
|
separate (System.Task_Primitives.Operations)
|
||||||
|
package body Specific is
|
||||||
|
|
||||||
|
----------------
|
||||||
|
-- Initialize --
|
||||||
|
----------------
|
||||||
|
|
||||||
|
procedure Initialize (Environment_Task : Task_Id) is
|
||||||
|
pragma Warnings (Off, Environment_Task);
|
||||||
|
Result : Interfaces.C.int;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := pthread_key_create (ATCB_Key'Access, null);
|
||||||
|
pragma Assert (Result = 0);
|
||||||
|
end Initialize;
|
||||||
|
|
||||||
|
-------------------
|
||||||
|
-- Is_Valid_Task --
|
||||||
|
-------------------
|
||||||
|
|
||||||
|
function Is_Valid_Task return Boolean is
|
||||||
|
begin
|
||||||
|
return pthread_getspecific (ATCB_Key) /= System.Null_Address;
|
||||||
|
end Is_Valid_Task;
|
||||||
|
|
||||||
|
---------
|
||||||
|
-- Set --
|
||||||
|
---------
|
||||||
|
|
||||||
|
procedure Set (Self_Id : Task_Id) is
|
||||||
|
Result : Interfaces.C.int;
|
||||||
|
begin
|
||||||
|
Result := pthread_setspecific (ATCB_Key, To_Address (Self_Id));
|
||||||
|
pragma Assert (Result = 0);
|
||||||
|
end Set;
|
||||||
|
|
||||||
|
----------
|
||||||
|
-- Self --
|
||||||
|
----------
|
||||||
|
|
||||||
|
-- To make Ada tasks and C threads interoperate better, we have added some
|
||||||
|
-- functionality to Self. Suppose a C main program (with threads) calls an
|
||||||
|
-- Ada procedure and the Ada procedure calls the tasking runtime system.
|
||||||
|
-- Eventually, a call will be made to self. Since the call is not coming
|
||||||
|
-- from an Ada task, there will be no corresponding ATCB.
|
||||||
|
|
||||||
|
-- What we do in Self is to catch references that do not come from
|
||||||
|
-- recognized Ada tasks, and create an ATCB for the calling thread.
|
||||||
|
|
||||||
|
-- The new ATCB will be "detached" from the normal Ada task master
|
||||||
|
-- hierarchy, much like the existing implicitly created signal-server
|
||||||
|
-- tasks.
|
||||||
|
|
||||||
|
function Self return Task_Id is
|
||||||
|
Result : System.Address;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := pthread_getspecific (ATCB_Key);
|
||||||
|
|
||||||
|
-- If the key value is Null then it is a non-Ada task
|
||||||
|
|
||||||
|
if Result /= System.Null_Address then
|
||||||
|
return To_Task_Id (Result);
|
||||||
|
else
|
||||||
|
return Register_Foreign_Thread;
|
||||||
|
end if;
|
||||||
|
end Self;
|
||||||
|
|
||||||
|
end Specific;
|
|
@ -6332,7 +6332,13 @@ package body Sem_Ch6 is
|
||||||
if In_Instance then
|
if In_Instance then
|
||||||
Set_Convention (Designator, Convention (E));
|
Set_Convention (Designator, Convention (E));
|
||||||
|
|
||||||
if Nkind (N) = N_Subprogram_Body
|
-- Skip past subprogram bodies and subprogram renamings that
|
||||||
|
-- may appear to have a matching spec, but that aren't fully
|
||||||
|
-- conformant with it. That can occur in cases where an
|
||||||
|
-- actual type causes unrelated homographs in the instance.
|
||||||
|
|
||||||
|
if Nkind_In (N, N_Subprogram_Body,
|
||||||
|
N_Subprogram_Renaming_Declaration)
|
||||||
and then Present (Homonym (E))
|
and then Present (Homonym (E))
|
||||||
and then not Fully_Conformant (Designator, E)
|
and then not Fully_Conformant (Designator, E)
|
||||||
then
|
then
|
||||||
|
|
|
@ -5461,7 +5461,7 @@ package body Sem_Ch8 is
|
||||||
return Old_S;
|
return Old_S;
|
||||||
end Report_Overload;
|
end Report_Overload;
|
||||||
|
|
||||||
-- Start of processing for Find_Renamed_Entry
|
-- Start of processing for Find_Renamed_Entity
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Old_S := Any_Id;
|
Old_S := Any_Id;
|
||||||
|
|
|
@ -1751,15 +1751,26 @@ package body Sem_Type is
|
||||||
-- case the resolution was to the explicit declaration in the
|
-- case the resolution was to the explicit declaration in the
|
||||||
-- generic, and remains so in the instance.
|
-- generic, and remains so in the instance.
|
||||||
|
|
||||||
|
-- The same sort of disambiguation needed for calls is also required
|
||||||
|
-- for the name given in a subprogram renaming, and that case is
|
||||||
|
-- handled here as well. We test Comes_From_Source to exclude this
|
||||||
|
-- treatment for implicit renamings created for formal subprograms.
|
||||||
|
|
||||||
elsif In_Instance
|
elsif In_Instance
|
||||||
and then not In_Generic_Actual (N)
|
and then not In_Generic_Actual (N)
|
||||||
then
|
then
|
||||||
if Nkind (N) = N_Function_Call
|
if Nkind (N) = N_Function_Call
|
||||||
or else Nkind (N) = N_Procedure_Call_Statement
|
or else Nkind (N) = N_Procedure_Call_Statement
|
||||||
|
or else
|
||||||
|
(Nkind (N) in N_Has_Entity
|
||||||
|
and then
|
||||||
|
Nkind (Parent (N)) = N_Subprogram_Renaming_Declaration
|
||||||
|
and then Comes_From_Source (Parent (N)))
|
||||||
then
|
then
|
||||||
declare
|
declare
|
||||||
Actual : Node_Id;
|
Actual : Node_Id;
|
||||||
Formal : Entity_Id;
|
Formal : Entity_Id;
|
||||||
|
Renam : Entity_Id := Empty;
|
||||||
Is_Act1 : constant Boolean := Is_Actual_Subprogram (Nam1);
|
Is_Act1 : constant Boolean := Is_Actual_Subprogram (Nam1);
|
||||||
Is_Act2 : constant Boolean := Is_Actual_Subprogram (Nam2);
|
Is_Act2 : constant Boolean := Is_Actual_Subprogram (Nam2);
|
||||||
|
|
||||||
|
@ -1781,14 +1792,32 @@ package body Sem_Type is
|
||||||
return It1;
|
return It1;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
-- In the case of a renamed subprogram, pick up the entity
|
||||||
|
-- of the renaming declaration so we can traverse its
|
||||||
|
-- formal parameters.
|
||||||
|
|
||||||
|
if Nkind (N) in N_Has_Entity then
|
||||||
|
Renam := Defining_Unit_Name (Specification (Parent (N)));
|
||||||
|
end if;
|
||||||
|
|
||||||
|
if Present (Renam) then
|
||||||
|
Actual := First_Formal (Renam);
|
||||||
|
else
|
||||||
Actual := First_Actual (N);
|
Actual := First_Actual (N);
|
||||||
|
end if;
|
||||||
|
|
||||||
Formal := First_Formal (Nam1);
|
Formal := First_Formal (Nam1);
|
||||||
while Present (Actual) loop
|
while Present (Actual) loop
|
||||||
if Etype (Actual) /= Etype (Formal) then
|
if Etype (Actual) /= Etype (Formal) then
|
||||||
return It2;
|
return It2;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
|
if Present (Renam) then
|
||||||
|
Next_Formal (Actual);
|
||||||
|
else
|
||||||
Next_Actual (Actual);
|
Next_Actual (Actual);
|
||||||
|
end if;
|
||||||
|
|
||||||
Next_Formal (Formal);
|
Next_Formal (Formal);
|
||||||
end loop;
|
end loop;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue