aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/sem_res.adb
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2011-08-02 16:46:28 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2011-08-02 16:46:28 +0200
commit1f6439e34bc08817b3a82b893810e14283fe280e (patch)
treeb03a52623c2c60777a03c69a4a170e54e79a9a34 /gcc/ada/sem_res.adb
parentc01ecafca3a2effd729b30df2aebfa8cef261ff6 (diff)
downloadgcc-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.adb40
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);