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

[multiple changes]

Browse Source 
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:
Arnaud Charlet 2011-08-03 12:50:14 +02:00
parent e0b23d9fd3
commit 0187b60e16
10 changed files with 257 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
gcc/ada/ChangeLog
View File

@ -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>
* make.adb, makeutl.adb, makeutl.ads, clean.adb (Makeutl.Queue): new

45
gcc/ada/exp_strm.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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 --
-- 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;
Ranges : List_Id;
Stms : List_Id;
Rstmt : Node_Id;
Indx : Node_Id;
Odecl : Node_Id;
begin
Decls := New_List;
@ -197,13 +199,13 @@ package body Exp_Strm is
-- build a subtype indication with the proper bounds.
if Is_Constrained (Stream_Base_Type (Typ)) then
Append_To (Decls,
Odecl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Make_Defining_Identifier (Loc, Name_V),
Object_Definition =>
New_Occurrence_Of (Stream_Base_Type (Typ), Loc)));
New_Occurrence_Of (Stream_Base_Type (Typ), Loc));
else
Append_To (Decls,
Odecl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Make_Defining_Identifier (Loc, Name_V),
Object_Definition =>
@ -212,19 +214,34 @@ package body Exp_Strm is
New_Occurrence_Of (Stream_Base_Type (Typ), Loc),
Constraint =>
Make_Index_Or_Discriminant_Constraint (Loc,
Constraints => Ranges))));
Constraints => Ranges)));
end if;
Stms := New_List (
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Typ, Loc),
Attribute_Name => Name_Read,
Expressions => New_List (
Make_Identifier (Loc, Name_S),
Make_Identifier (Loc, Name_V))),
Rstmt := Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Typ, Loc),
Attribute_Name => Name_Read,
Expressions => New_List (
Make_Identifier (Loc, Name_S),
Make_Identifier (Loc, Name_V)));
Make_Simple_Return_Statement (Loc,
Expression => 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,
Expression => Make_Identifier (Loc, Name_V)));
end if;
Fnam :=
Make_Defining_Identifier (Loc,

5
gcc/ada/exp_util.adb
View File

@ -1371,8 +1371,11 @@ package body Exp_Util is
-- If the type is class-wide, the expression is dynamically tagged and
-- 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
(Is_Class_Wide_Type (Exp_Typ)
or else Is_Interface (Exp_Typ)

2
gcc/ada/gcc-interface/Makefile.in
View File

@ -1520,7 +1520,7 @@ ifeq ($(strip $(filter-out alpha64 ia64 dec hp vms% openvms% alphavms%,$(targ)))
s-taprop.adb<s-taprop-vms.adb \
s-tasdeb.adb<s-tasdeb-vms.adb \
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.ads<s-tpopde-vms.ads

43
gcc/ada/make.adb
View File

@ -61,17 +61,18 @@ pragma Warnings (On);
with Switch; use Switch;
with Switch.M; use Switch.M;
with Targparm; use Targparm;
with Table;
with Targparm; use Targparm;
with Tempdir;
with Types; use Types;
with Ada.Exceptions; use Ada.Exceptions;
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.Dynamic_HTables; use GNAT.Dynamic_HTables;
with GNAT.Case_Util; use GNAT.Case_Util;
with GNAT.OS_Lib; use GNAT.OS_Lib;
package body Make is
@ -5898,6 +5899,10 @@ package body Make is
Prj.Env.Set_Ada_Paths
(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
@ -6729,6 +6734,38 @@ package body Make is
Make_Failed ("-i and -D cannot be used simultaneously");
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
if Gnatmake_Mapping_File /= null then

3
gcc/ada/s-taprop-vms.adb
View File

@ -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.
-- 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;
-- A variable to hold Task_Id for the environment task

103
gcc/ada/s-tpopsp-vms.adb Normal file
View File

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

8
gcc/ada/sem_ch6.adb
View File

@ -6332,7 +6332,13 @@ package body Sem_Ch6 is
if In_Instance then
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 not Fully_Conformant (Designator, E)
then

2
gcc/ada/sem_ch8.adb
View File

@ -5461,7 +5461,7 @@ package body Sem_Ch8 is
return Old_S;
end Report_Overload;
-- Start of processing for Find_Renamed_Entry
-- Start of processing for Find_Renamed_Entity
begin
Old_S := Any_Id;

33
gcc/ada/sem_type.adb
View File

@ -1751,15 +1751,26 @@ package body Sem_Type is
-- case the resolution was to the explicit declaration in the
-- 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
and then not In_Generic_Actual (N)
then
if Nkind (N) = N_Function_Call
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
declare
Actual : Node_Id;
Formal : Entity_Id;
Renam : Entity_Id := Empty;
Is_Act1 : constant Boolean := Is_Actual_Subprogram (Nam1);
Is_Act2 : constant Boolean := Is_Actual_Subprogram (Nam2);
@ -1781,14 +1792,32 @@ package body Sem_Type is
return It1;
end if;
Actual := First_Actual (N);
-- 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);
end if;
Formal := First_Formal (Nam1);
while Present (Actual) loop
if Etype (Actual) /= Etype (Formal) then
return It2;
end if;
Next_Actual (Actual);
if Present (Renam) then
Next_Formal (Actual);
else
Next_Actual (Actual);
end if;
Next_Formal (Formal);
end loop;