From: Arnaud Charlet Date: Tue, 2 Aug 2011 14:46:28 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=1f6439e34bc08817b3a82b893810e14283fe280e;p=gcc.git [multiple changes] 2011-08-02 Javier Miranda * 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 * 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 * sem_res.adb (Resolve_Call): implement rule in RM 12.5.1 (23.3/2). From-SVN: r177167 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2c473c08846..93d8439ac16 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2011-08-02 Javier Miranda + + * 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 + + * 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 + + * sem_res.adb (Resolve_Call): implement rule in RM 12.5.1 (23.3/2). + 2011-08-02 Robert Dewar * exp_ch7.adb exp_ch6.adb, exp_disp.adb: Minor reformatting diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index a2564c48d65..b9af60ead86 100644 --- a/gcc/ada/exp_ch6.adb +++ b/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; diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 6e67362637c..d2c7725dec1 100644 --- a/gcc/ada/exp_ch7.adb +++ b/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. diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 4b0e8c96e0d..9eff2347e80 100644 --- a/gcc/ada/exp_disp.adb +++ b/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; diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 27abe8b7bbf..1baba1a6e37 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/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; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 4d54142b5b8..f8e19a1b0e5 100644 --- a/gcc/ada/sem_res.adb +++ b/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);