+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
-- 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;
-- 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.
-- --
-- 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- --
-- 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,
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 --
----------------------
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 --
-----------------------
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;
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
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
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;
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;
-- --
-- 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- --
-- 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);
projects / gcc.git / commitdiff