* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@146411
138bc75d-0d04-0410-961f-
82ee72b054a4
+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
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
-- 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
end if;
if Exename /= System.Null_Address then
+ Len := Res'Length;
convert_addresses
(Exename, Traceback'Address, Traceback'Length,
Res (1)'Address, Len'Address);
-- 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;
-- 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
Call : Node_Id;
Subp : Entity_Id) return Entity_Id
is
+ Arr_Type : Entity_Id;
Comp_Type : Entity_Id;
begin
-- 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
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
---------------------------
function Find_Dispatching_Type (Subp : Entity_Id) return Entity_Id is
+ A_Formal : Entity_Id;
Formal : Entity_Id;
Ctrl_Type : Entity_Id;
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
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;
projects / platform / upstream / linaro-gcc.git / commitdiff