From 2290a0fec1ffaa96f33dcc79bef60ed3c00fd947 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 20 Feb 2015 15:35:51 +0100 Subject: [multiple changes] 2015-02-20 Robert Dewar * errout.ads: Document replacement of Name_uPre/Post/Type_Invariant. * erroutc.adb (Set_Msg_Str): Replace _xxx. (Pre/Post/Type_Invariant) by xxx'Class. * erroutc.ads (Set_Msg_Str): Replace _xxx. (Pre/Post/Type_Invariant) by xxx'Class. * sem_prag.adb (Fix_Error): Remove special casing of Name_uType_Invariant. (Analyze_Pre_Post_Condition_In_Decl_Part): Remove special casing of Name_uPre and Name_uPost in aspect case (done in Errout now). 2015-02-20 Robert Dewar * g-alveop.adb: Minor style fixes. 2015-02-20 Robert Dewar * freeze.adb (Warn_Overlay): Guard against blow up with address clause. 2015-02-20 Bob Duff * exp_attr.adb (May_Be_External_Call): Remove this. There is no need for the compiler to guess whether the call is internal or external -- it is always external. (Expand_Access_To_Protected_Op): For P'Access, where P is a protected subprogram, always create a pointer to the External_Subprogram. From-SVN: r220869 --- gcc/ada/erroutc.adb | 45 ++++++++++++++++++++++++++++++++++++++------- 1 file changed, 38 insertions(+), 7 deletions(-) (limited to 'gcc/ada/erroutc.adb') diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb index 32d9bbc..c76c1ce 100644 --- a/gcc/ada/erroutc.adb +++ b/gcc/ada/erroutc.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, 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- -- @@ -1344,9 +1344,7 @@ package body Erroutc is procedure Set_Msg_Name_Buffer is begin - for J in 1 .. Name_Len loop - Set_Msg_Char (Name_Buffer (J)); - end loop; + Set_Msg_Str (Name_Buffer (1 .. Name_Len)); end Set_Msg_Name_Buffer; ------------------- @@ -1366,9 +1364,42 @@ package body Erroutc is procedure Set_Msg_Str (Text : String) is begin - for J in Text'Range loop - Set_Msg_Char (Text (J)); - end loop; + -- Do replacement for special x'Class aspect names + + if Text = "_Pre" then + Set_Msg_Str ("Pre'Class"); + + elsif Text = "_Post" then + Set_Msg_Str ("Post'Class"); + + elsif Text = "_Type_Invariant" then + Set_Msg_Str ("Type_Invariant'Class"); + + elsif Text = "_pre" then + Set_Msg_Str ("pre'class"); + + elsif Text = "_post" then + Set_Msg_Str ("post'class"); + + elsif Text = "_type_invariant" then + Set_Msg_Str ("type_invariant'class"); + + elsif Text = "_PRE" then + Set_Msg_Str ("PRE'CLASS"); + + elsif Text = "_POST" then + Set_Msg_Str ("POST'CLASS"); + + elsif Text = "_TYPE_INVARIANT" then + Set_Msg_Str ("TYPE_INVARIANT'CLASS"); + + -- Normal case with no replacement + + else + for J in Text'Range loop + Set_Msg_Char (Text (J)); + end loop; + end if; end Set_Msg_Str; ------------------------------ -- cgit v1.1