diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2011-08-02 16:46:28 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2011-08-02 16:46:28 +0200 |
commit | 1f6439e34bc08817b3a82b893810e14283fe280e (patch) | |
tree | b03a52623c2c60777a03c69a4a170e54e79a9a34 /gcc/ada/sem_res.adb | |
parent | c01ecafca3a2effd729b30df2aebfa8cef261ff6 (diff) | |
download | gcc-1f6439e34bc08817b3a82b893810e14283fe280e.zip gcc-1f6439e34bc08817b3a82b893810e14283fe280e.tar.gz gcc-1f6439e34bc08817b3a82b893810e14283fe280e.tar.bz2 |
[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
Diffstat (limited to 'gcc/ada/sem_res.adb')
-rw-r--r-- | gcc/ada/sem_res.adb | 40 |
1 files changed, 39 insertions, 1 deletions
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 4d54142..f8e19a1 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); |