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

[multiple changes]

Browse Source 
2009-04-20  Javier Miranda  <miranda@adacore.com>

	* sem_disp.adb (Find_Dispatching_Type): For subprograms internally
	generated by derivations of tagged types use the aliased subprogram a
	reference to locate their controlling type.

2009-04-20  Tristan Gingold  <gingold@adacore.com>

	* g-trasym.adb: Set size of result buffer before calling
	convert_address.

2009-04-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Valid_Candidate): When checking whether a prefixed call
	to a function returning an array can be interpreted as a call with
	defaulted parameters whose result is indexed, take into account the
	types of all the indices of the array result type.

2009-04-20  Pascal Obry  <obry@adacore.com>

	* a-direct.adb, s-os_lib.adb: Minor reformatting.

From-SVN: r146411
This commit is contained in:
Arnaud Charlet 2009-04-20 14:59:51 +02:00
parent bddd6058a2
commit ee9aa7b663
6 changed files with 134 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
gcc/ada/ChangeLog
View File

@ -1,3 +1,25 @@
2009-04-20 Javier Miranda <miranda@adacore.com>
* sem_disp.adb (Find_Dispatching_Type): For subprograms internally
generated by derivations of tagged types use the aliased subprogram a
reference to locate their controlling type.
2009-04-20 Tristan Gingold <gingold@adacore.com>
* g-trasym.adb: Set size of result buffer before calling
convert_address.
2009-04-20 Ed Schonberg <schonberg@adacore.com>
* sem_ch4.adb (Valid_Candidate): When checking whether a prefixed call
to a function returning an array can be interpreted as a call with
defaulted parameters whose result is indexed, take into account the
types of all the indices of the array result type.
2009-04-20 Pascal Obry <obry@adacore.com>
* a-direct.adb, s-os_lib.adb: Minor reformatting.
2009-04-20 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Analyze_Object_Renaming): Proper checks on incorrect

3
gcc/ada/a-direct.adb
View File

@ -1154,8 +1154,7 @@ package body Ada.Directories is
end Simple_Name;
function Simple_Name
(Directory_Entry : Directory_Entry_Type) return String
is
(Directory_Entry : Directory_Entry_Type) return String is
begin
-- First, the invalid case

4
gcc/ada/g-trasym.adb
View File

@ -77,7 +77,8 @@ package body GNAT.Traceback.Symbolic is
-- This is the procedure version of the Ada aware addr2line. It places
-- in BUF a string representing the symbolic translation of the N_ADDRS
-- raw addresses provided in ADDRS, looked up in debug information from
-- FILENAME. LEN is filled with the result length.
-- FILENAME. LEN points to an integer which contains the size of the
-- BUF buffer at input and the result length at output.
--
-- This procedure is provided by libaddr2line on targets that support
-- it. A dummy version is in adaint.c for other targets so that build
@ -125,6 +126,7 @@ package body GNAT.Traceback.Symbolic is
end if;
if Exename /= System.Null_Address then
Len := Res'Length;
convert_addresses
(Exename, Traceback'Address, Traceback'Length,
Res (1)'Address, Len'Address);

58
gcc/ada/s-os_lib.adb
View File

@ -1833,8 +1833,8 @@ package body System.OS_Lib is
-- By default, the drive letter on Windows is in upper case
if On_Windows and then Path_Len >= 2 and then
Buffer (2) = ':'
if On_Windows and then Path_Len >= 2
and then Buffer (2) = ':'
then
System.Case_Util.To_Upper (Buffer (1 .. 1));
end if;
@ -1906,31 +1906,41 @@ package body System.OS_Lib is
-- it may have multiple equivalences and if resolved we will only
-- get the first one.
-- On Windows, if we have an absolute path starting with a directory
-- separator, we need to have the drive letter appended in front.
if On_Windows then
-- On Windows, Get_Current_Dir will return a suitable directory
-- name (path starting with a drive letter on Windows). So we take this
-- drive letter and prepend it to the current path.
-- On Windows, if we have an absolute path starting with a directory
-- separator, we need to have the drive letter appended in front.
if On_Windows
and then Path_Buffer (1) = Directory_Separator
and then Path_Buffer (2) /= Directory_Separator
then
declare
Cur_Dir : constant String := Get_Directory ("");
-- Get the current directory to get the drive letter
-- On Windows, Get_Current_Dir will return a suitable directory name
-- (path starting with a drive letter on Windows). So we take this
-- drive letter and prepend it to the current path.
begin
if Cur_Dir'Length > 2
and then Cur_Dir (Cur_Dir'First + 1) = ':'
then
Path_Buffer (3 .. End_Path + 2) := Path_Buffer (1 .. End_Path);
Path_Buffer (1 .. 2) :=
Cur_Dir (Cur_Dir'First .. Cur_Dir'First + 1);
End_Path := End_Path + 2;
end if;
end;
if Path_Buffer (1) = Directory_Separator
and then Path_Buffer (2) /= Directory_Separator
then
declare
Cur_Dir : constant String := Get_Directory ("");
-- Get the current directory to get the drive letter
begin
if Cur_Dir'Length > 2
and then Cur_Dir (Cur_Dir'First + 1) = ':'
then
Path_Buffer (3 .. End_Path + 2) :=
Path_Buffer (1 .. End_Path);
Path_Buffer (1 .. 2) :=
Cur_Dir (Cur_Dir'First .. Cur_Dir'First + 1);
End_Path := End_Path + 2;
end if;
end;
-- We have a drive letter, ensure it is upper-case
elsif Path_Buffer (1) in 'a' .. 'z'
and then Path_Buffer (2) = ':'
then
System.Case_Util.To_Upper (Path_Buffer (1 .. 1));
end if;
end if;
-- On Windows, remove all double-quotes that are possibly part of the

46
gcc/ada/sem_ch4.adb
View File

@ -5829,6 +5829,7 @@ package body Sem_Ch4 is
Call : Node_Id;
Subp : Entity_Id) return Entity_Id
is
Arr_Type : Entity_Id;
Comp_Type : Entity_Id;
begin
@ -5844,6 +5845,7 @@ package body Sem_Ch4 is
-- If the call may be an indexed call, retrieve component type of
-- resulting expression, and add possible interpretation.
Arr_Type := Empty;
Comp_Type := Empty;
if Nkind (Call) = N_Function_Call
@ -5851,19 +5853,51 @@ package body Sem_Ch4 is
and then Needs_One_Actual (Subp)
then
if Is_Array_Type (Etype (Subp)) then
Comp_Type := Component_Type (Etype (Subp));
Arr_Type := Etype (Subp);
elsif Is_Access_Type (Etype (Subp))
and then Is_Array_Type (Designated_Type (Etype (Subp)))
then
Comp_Type := Component_Type (Designated_Type (Etype (Subp)));
Arr_Type := Designated_Type (Etype (Subp));
end if;
end if;
if Present (Comp_Type)
and then Etype (Subprog) /= Comp_Type
then
Add_One_Interp (Subprog, Subp, Comp_Type);
if Present (Arr_Type) then
-- Verify that the actuals (excluding the object)
-- match the types of the indices.
declare
Actual : Node_Id;
Index : Node_Id;
begin
Actual := Next (First_Actual (Call));
Index := First_Index (Arr_Type);
while Present (Actual) and then Present (Index) loop
if not Has_Compatible_Type (Actual, Etype (Index)) then
Arr_Type := Empty;
exit;
end if;
Next_Actual (Actual);
Next_Index (Index);
end loop;
if No (Actual)
and then No (Index)
and then Present (Arr_Type)
then
Comp_Type := Component_Type (Arr_Type);
end if;
end;
if Present (Comp_Type)
and then Etype (Subprog) /= Comp_Type
then
Add_One_Interp (Subprog, Subp, Comp_Type);
end if;
end if;
if Etype (Call) /= Any_Type then

40
gcc/ada/sem_disp.adb
View File

@ -1395,6 +1395,7 @@ package body Sem_Disp is
---------------------------
function Find_Dispatching_Type (Subp : Entity_Id) return Entity_Id is
A_Formal : Entity_Id;
Formal : Entity_Id;
Ctrl_Type : Entity_Id;
@ -1402,6 +1403,37 @@ package body Sem_Disp is
if Present (DTC_Entity (Subp)) then
return Scope (DTC_Entity (Subp));
-- For subprograms internally generated by derivations of tagged types
-- use the alias subprogram as a reference to locate the dispatching
-- type of Subp
elsif not Comes_From_Source (Subp)
and then Present (Alias (Subp))
and then Is_Dispatching_Operation (Alias (Subp))
then
if Ekind (Alias (Subp)) = E_Function
and then Has_Controlling_Result (Alias (Subp))
then
return Check_Controlling_Type (Etype (Subp), Subp);
else
Formal := First_Formal (Subp);
A_Formal := First_Formal (Alias (Subp));
while Present (A_Formal) loop
if Is_Controlling_Formal (A_Formal) then
return Check_Controlling_Type (Etype (Formal), Subp);
end if;
Next_Formal (Formal);
Next_Formal (A_Formal);
end loop;
pragma Assert (False);
return Empty;
end if;
-- General case
else
Formal := First_Formal (Subp);
while Present (Formal) loop
@ -1414,14 +1446,10 @@ package body Sem_Disp is
Next_Formal (Formal);
end loop;
-- The subprogram may also be dispatching on result
-- The subprogram may also be dispatching on result
if Present (Etype (Subp)) then
Ctrl_Type := Check_Controlling_Type (Etype (Subp), Subp);
if Present (Ctrl_Type) then
return Ctrl_Type;
end if;
return Check_Controlling_Type (Etype (Subp), Subp);
end if;
end if;