Skip to content

R
riscv-gcc-1
Commit 1f6439e3 by Arnaud Charlet
Options

[multiple changes] 

2011-08-02  Javier Miranda  <miranda@adacore.com>

	* exp_ch6.adb (Expand_N_Subprogram_Body): Enable generation of TSDs in
	the JVM target.
	* exp_ch7.adb (Expand_N_Package_Body): Enable generation of TSDs in
	the JVM target.
	* exp_disp.adb (Build_VM_TSDs): No action needed if the runtime has no
	TSD support.

2011-08-02  Vincent Celier  <celier@adacore.com>

	* prj-nmsc.adb (File_Found): New components Excl_File and Excl_Line
	(No_Space_Img): New function
	(Find_Excluded_Sources): When reading from a file, record the file name
	and the line number for each excluded source.
	(Mark_Excluded_Sources): When reporting an error, if the excluded
	sources were read from a file, include file name and line number in
	the error message.

2011-08-02  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Resolve_Call): implement rule in RM 12.5.1 (23.3/2).

From-SVN: r177167
parent c01ecafc
Showing with 130 additions and 29 deletions
gcc/ada/ChangeLog
2011-08-02 Javier Miranda <miranda@adacore.com>
* exp_ch6.adb (Expand_N_Subprogram_Body): Enable generation of TSDs in
the JVM target.
* exp_ch7.adb (Expand_N_Package_Body): Enable generation of TSDs in
the JVM target.
* exp_disp.adb (Build_VM_TSDs): No action needed if the runtime has no
TSD support.
2011-08-02 Vincent Celier <celier@adacore.com>
* prj-nmsc.adb (File_Found): New components Excl_File and Excl_Line
(No_Space_Img): New function
(Find_Excluded_Sources): When reading from a file, record the file name
and the line number for each excluded source.
(Mark_Excluded_Sources): When reporting an error, if the excluded
sources were read from a file, include file name and line number in
the error message.
2011-08-02 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Resolve_Call): implement rule in RM 12.5.1 (23.3/2).
2011-08-02 Robert Dewar <dewar@adacore.com>
* exp_ch7.adb exp_ch6.adb, exp_disp.adb: Minor reformatting
......
gcc/ada/exp_ch6.adb
......@@ -5125,11 +5125,8 @@ package body Exp_Ch6 is
-- VM targets, we now generate the Type Specific Data record of all the
-- enclosing tagged type declarations.
-- Temporarily restrict this support to the .NET compiler???
if not Tagged_Type_Expansion
and then Unit (Cunit (Main_Unit)) = N
and then VM_Target = CLI_Target
then
Build_VM_TSDs (N);
end if;
......
gcc/ada/exp_ch7.adb
......@@ -1559,11 +1559,7 @@ package body Exp_Ch7 is
-- In VM targets there is no need to build dispatch tables but
-- we must generate the corresponding Type Specific Data record.
-- Temporarily restrict this support to the .NET compiler???
elsif Unit (Cunit (Main_Unit)) = N
and then VM_Target = CLI_Target
then
elsif Unit (Cunit (Main_Unit)) = N then
Build_VM_TSDs (N);
end if;
end if;
......@@ -1672,11 +1668,8 @@ package body Exp_Ch7 is
-- In VM targets there is no need to build dispatch tables, but we
-- must generate the corresponding Type Specific Data record.
-- Temporarily restrict this support to the .NET compiler???
elsif Unit (Cunit (Main_Unit)) = N then
elsif Unit (Cunit (Main_Unit)) = N
and then VM_Target = CLI_Target
then
-- Enter the scope of the package because the new declarations are
-- appended at the end of the package and must be analyzed in that
-- context.
......
gcc/ada/exp_disp.adb
......@@ -569,7 +569,10 @@ package body Exp_Disp is
-- Start of processing for Build_VM_TSDs
begin
if not Expander_Active or else No_Run_Time_Mode then
if not Expander_Active
or else No_Run_Time_Mode
or else not RTE_Available (RE_Type_Specific_Data)
then
return;
end if;
......
gcc/ada/prj-nmsc.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2000-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2000-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- --
......@@ -106,12 +106,15 @@ package body Prj.Nmsc is
-- exceptions specified in the project files.
type File_Found is record
File : File_Name_Type := No_File;
Found : Boolean := False;
Location : Source_Ptr := No_Location;
File : File_Name_Type := No_File;
Excl_File : File_Name_Type := No_File;
Excl_Line : Natural := 0;
Found : Boolean := False;
Location : Source_Ptr := No_Location;
end record;
No_File_Found : constant File_Found := (No_File, False, No_Location);
No_File_Found : constant File_Found :=
(No_File, No_File, 0, False, No_Location);
package Excluded_Sources_Htable is new GNAT.Dynamic_HTables.Simple_HTable
(Header_Num => Header_Num,
......@@ -522,6 +525,9 @@ package body Prj.Nmsc is
Project : Project_Id);
-- Emits either an error or warning message (or nothing), depending on Kind
function No_Space_Img (N : Natural) return String;
-- Image of a Natural without the initial space
----------------------
-- Error_Or_Warning --
----------------------
......@@ -5507,6 +5513,16 @@ package body Prj.Nmsc is
end if;
end Get_Sources_From_File;
------------------
-- No_Space_Img --
------------------
function No_Space_Img (N : Natural) return String is
Image : constant String := N'Img;
begin
return Image (2 .. Image'Last);
end No_Space_Img;
-----------------------
-- Compute_Unit_Name --
-----------------------
......@@ -6045,7 +6061,8 @@ package body Prj.Nmsc is
end if;
Excluded_Sources_Htable.Set
(Project.Excluded, Name, (Name, False, Location));
(Project.Excluded, Name,
(Name, No_File, 0, False, Location));
Current := Element.Next;
end loop;
......@@ -6053,10 +6070,14 @@ package body Prj.Nmsc is
Location := Excluded_Source_List_File.Location;
declare
Source_File_Name : constant File_Name_Type :=
File_Name_Type
(Excluded_Source_List_File.Value);
Source_File_Line : Natural := 0;
Source_File_Path_Name : constant String :=
Path_Name_Of
(File_Name_Type
(Excluded_Source_List_File.Value),
(Source_File_Name,
Project.Project.Directory.Name);
begin
......@@ -6082,6 +6103,7 @@ package body Prj.Nmsc is
while not Prj.Util.End_Of_File (File) loop
Prj.Util.Get_Line (File, Line, Last);
Source_File_Line := Source_File_Line + 1;
-- Non empty, non comment line should contain a file name
......@@ -6110,7 +6132,10 @@ package body Prj.Nmsc is
end loop;
Excluded_Sources_Htable.Set
(Project.Excluded, Name, (Name, False, Location));
(Project.Excluded,
Name,
(Name, Source_File_Name, Source_File_Line,
False, Location));
end if;
end loop;
......@@ -7579,14 +7604,36 @@ package body Prj.Nmsc is
Err_Vars.Error_Msg_File_1 := Excluded.File;
if Src = No_Source then
Error_Msg
if Excluded.Excl_File = No_File then
Error_Msg
(Data.Flags,
"unknown file {", Excluded.Location, Project.Project);
else
Error_Msg
(Data.Flags,
"unknown file {", Excluded.Location, Project.Project);
"in " &
Get_Name_String (Excluded.Excl_File) & ":" &
No_Space_Img (Excluded.Excl_Line) &
": unknown file {", Excluded.Location, Project.Project);
end if;
else
Error_Msg
(Data.Flags,
"cannot remove a source from an imported project: {",
Excluded.Location, Project.Project);
if Excluded.Excl_File = No_File then
Error_Msg
(Data.Flags,
"cannot remove a source from an imported project: {",
Excluded.Location, Project.Project);
else
Error_Msg
(Data.Flags,
"in " &
Get_Name_String (Excluded.Excl_File) & ":" &
No_Space_Img (Excluded.Excl_Line) &
": cannot remove a source from an imported project: {",
Excluded.Location, Project.Project);
end if;
end if;
end if;
......
gcc/ada/sem_res.adb
......@@ -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- --
......@@ -5751,6 +5751,44 @@ package body Sem_Res is
-- Check_Formal_Restriction ("function not inherited", N);
-- end if;
-- Implement rule in 12.5.1 (23.3/2) : in an instance, if the actual
-- is class-wide and the call dispatches on result in a context that
-- does not provide a tag, the call raises Program_Error.
if Nkind (N) = N_Function_Call
and then In_Instance
and then Is_Generic_Actual_Type (Typ)
and then Is_Class_Wide_Type (Typ)
and then Has_Controlling_Result (Nam)
and then Nkind (Parent (N)) = N_Object_Declaration
then
-- verify that none of the formals are controlling.
declare
Call_OK : Boolean := False;
F : Entity_Id;
begin
F := First_Formal (Nam);
while Present (F) loop
if Is_Controlling_Formal (F) then
Call_OK := True;
exit;
end if;
Next_Formal (F);
end loop;
if not Call_OK then
Error_Msg_N ("!? cannot determine tag of result", N);
Error_Msg_N ("!? Program_Error will be raised", N);
Insert_Action (N,
Make_Raise_Program_Error (Sloc (N),
Reason => PE_Explicit_Raise));
end if;
end;
end if;
-- All done, evaluate call and deal with elaboration issues
Eval_Call (N);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment