From: Ed Schonberg <schonberg@adacore.com>
Date: Wed, 29 Apr 2009 09:31:29 +0000 (+0000)
Subject: sem_ch3.adb (Check_Abstract_Overriding): Improve error message when an abstract opera... 
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=8f983e64b28624ef2cd8d25e1257820c197c6196;p=gcc.git

sem_ch3.adb (Check_Abstract_Overriding): Improve error message when an abstract operation of a progenitor is not...

2009-04-29  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Check_Abstract_Overriding): Improve error message when
	an abstract operation of a progenitor is not properly overridden by an
	operation of a derived synchronized type.

From-SVN: r146934
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3a114f43baf..268cd62ac70 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2009-04-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Check_Abstract_Overriding): Improve error message when
+	an abstract operation of a progenitor is not properly overridden by an
+	operation of a derived synchronized type.
+
 2009-04-29  Robert Dewar  <dewar@adacore.com>
 
 	* mlib-prj.adb, mlib-tgt.adb, mlib-tgt.ads, prj-nmsc.adb,
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index be87d0c8793..8f3d3f552ab 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2009, 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- --
@@ -8321,7 +8321,9 @@ package body Sem_Ch3 is
                   --  Error message below needs rewording (remember comma
                   --  in -gnatj mode) ???
 
-                  if Ekind (First_Formal (Subp)) = E_In_Parameter then
+                  if Ekind (First_Formal (Subp)) = E_In_Parameter
+                    and then Ekind (Subp) /= E_Function
+                  then
                      if not Is_Predefined_Dispatching_Operation (Subp) then
                         Error_Msg_NE
                           ("first formal of & must be of mode `OUT`, " &
@@ -8337,6 +8339,27 @@ package body Sem_Ch3 is
                      Error_Msg_NE
                        ("interface subprogram & must be overridden",
                         T, Subp);
+
+                     --  Examine primitive operations of synchronized type,
+                     --  to find homonyms that have the wrong profile.
+
+                     declare
+                        Prim : Entity_Id;
+
+                     begin
+                        Prim :=
+                          First_Entity (Corresponding_Concurrent_Type (T));
+                        while Present (Prim) loop
+                           if Chars (Prim) = Chars (Subp) then
+                              Error_Msg_NE
+                                ("profile is not type conformant with "
+                                   & "prefixed view profile of "
+                                   & "inherited operation&", Prim, Subp);
+                           end if;
+
+                           Next_Entity (Prim);
+                        end loop;
+                     end;
                   end if;
                end if;