From: Thomas Quinot Date: Wed, 26 Mar 2008 07:41:04 +0000 (+0100) Subject: sem_cat.adb (Validate_RACW_Primitives): Do not rely on Comes_From_Source to exclude... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=2b2b6798119883d6cc535db15cc19baaae32bb49;p=gcc.git sem_cat.adb (Validate_RACW_Primitives): Do not rely on Comes_From_Source to exclude primitives from being checked. 2008-03-26 Thomas Quinot * sem_cat.adb (Validate_RACW_Primitives): Do not rely on Comes_From_Source to exclude primitives from being checked. We want to exclude predefined primitives only, so use the appropriate specific predicate. Also, flag a formal parameter of an anonymous access-to-subprogram type as illegal for a primitive operation of a remote access to class-wide type. From-SVN: r133572 --- diff --git a/gcc/ada/sem_cat.adb b/gcc/ada/sem_cat.adb index 9bcd622a426..b9dbfb18f94 100644 --- a/gcc/ada/sem_cat.adb +++ b/gcc/ada/sem_cat.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -28,6 +28,7 @@ with Debug; use Debug; with Einfo; use Einfo; with Elists; use Elists; with Errout; use Errout; +with Exp_Util; use Exp_Util; with Fname; use Fname; with Lib; use Lib; with Namet; use Namet; @@ -214,11 +215,26 @@ package body Sem_Cat is -- Here we have an error else - if Is_Subunit then + -- Don't give error if main unit is not an internal unit, and the + -- unit generating the message is an internal unit. This is the + -- situation in which such messages would be ignored in any case, + -- so it is convenient not to generate them (since it causes + -- annoying inteference with debugging) + + if Is_Internal_File_Name (Unit_File_Name (Current_Sem_Unit)) + and then not Is_Internal_File_Name (Unit_File_Name (Main_Unit)) + then + return; + + -- Subunit case + + elsif Is_Subunit then Error_Msg_NE ("> @@ -1654,7 +1690,7 @@ package body Sem_Cat is Error_Msg_N ("error in designated type of remote access to class-wide type", T); Error_Msg_N - ("\must be tagged limited private or private extension of type", T); + ("\must be tagged limited private or private extension", T); return; end if; @@ -1788,7 +1824,7 @@ package body Sem_Cat is return; end if; - Error_Msg_N ("incorrect remote type dereference", N); + Error_Msg_N ("incorrect dereference of remote type", N); end if; end Validate_Remote_Access_To_Class_Wide_Type;