2011-08-01 Yannick Moy <moy@adacore.com>

	* err_vars.ads (Error_Msg_Lang, Error_Msg_Langlen): new variables for
	insertion character ~~
	* errout.ads, errout.adb (Formal_Error_Msg_...): remove procedures
	(Set_Error_Msg_Lang): new procedure which fixes the language for use
	with insertion character ~~
	(Set_Msg_Text): treat insertion character ~~
	* par-ch4.adb, par-ch5.adb, par-endh.adb, sem_attr.adb, sem_ch11.adb,
	sem_ch3.adb, sem_ch5.adb, sem_ch9.adb, sem_util.adb: Replace calls to
	Formal_Error_Msg_... procedures by equivalent Error_Msg_...
	procedures. Favor calls to Error_Msg_F(E) over Error_Msg_N(E). Make
	errors related to the formal language restriction not serious
	(insertion character |).
	* par.adb (Par): set formal language for error messages if needed
	* sem_ch6.adb (Check_Missing_Return): take into account possible
	generated statements at the end of the function
	* snames.ads-tmpl (Name_SPARK_95, Pragma_SPARK_95): new variable and
	enumeration value to define a new pragma SPARK_95
	* opt.ads, opt.adb (SPARK_Version_Type, SPARK_Version_Default,
	SPARK_Version): new type and variables to store the SPARK version
	(none by default).
	(SPARK_Mode): return True when SPARK_Version is set
	* par-prag.adb: Correct indentation
	(Prag): take Pragma_SPARK_95 into account
	* sem_prag.adb (Set_Mechanism_Value, Sig_Flags): take Pragma_SPARK_95
	into account.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@177056 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 16 insertions, 45 deletions

diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 0703afc89a7..be963dbf952 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -1402,49 +1402,6 @@ package body Errout is
       return S;
    end First_Sloc;
 
-   ----------------------
-   -- Formal_Error_Msg --
-   ----------------------
-
-   procedure Formal_Error_Msg (Msg : String; Flag_Location : Source_Ptr) is
-   begin
-      pragma Assert (Formal_Verification_Mode);
-      Error_Msg ("(" & Formal_Language & ") " & Msg, Flag_Location);
-   end Formal_Error_Msg;
-
-   ------------------------
-   -- Formal_Error_Msg_N --
-   ------------------------
-
-   procedure Formal_Error_Msg_N (Msg : String; N : Node_Id) is
-   begin
-      pragma Assert (Formal_Verification_Mode);
-      Error_Msg_N ("(" & Formal_Language & ") " & Msg, N);
-   end Formal_Error_Msg_N;
-
-   -------------------------
-   -- Formal_Error_Msg_NE --
-   -------------------------
-
-   procedure Formal_Error_Msg_NE
-     (Msg : String;
-      N   : Node_Or_Entity_Id;
-      E   : Node_Or_Entity_Id) is
-   begin
-      pragma Assert (Formal_Verification_Mode);
-      Error_Msg_NE ("(" & Formal_Language & ") " & Msg, N, E);
-   end Formal_Error_Msg_NE;
-
-   -------------------------
-   -- Formal_Error_Msg_SP --
-   -------------------------
-
-   procedure Formal_Error_Msg_SP (Msg : String) is
-   begin
-      pragma Assert (Formal_Verification_Mode);
-      Error_Msg_SP ("(" & Formal_Language & ") " & Msg);
-   end Formal_Error_Msg_SP;
-
    ----------------
    -- Initialize --
    ----------------
@@ -2214,6 +2171,16 @@ package body Errout is
       Set_Casing (Desired_Case);
    end Set_Identifier_Casing;
 
+   ------------------------
+   -- Set_Error_Msg_Lang --
+   ------------------------
+
+   procedure Set_Error_Msg_Lang (To : String) is
+   begin
+      Error_Msg_Langlen := To'Length;
+      Error_Msg_Lang (1 .. Error_Msg_Langlen) := To;
+   end Set_Error_Msg_Lang;
+
    -----------------------
    -- Set_Ignore_Errors --
    -----------------------
@@ -2675,7 +2642,6 @@ package body Errout is
                if P <= Text'Last and then Text (P) = '$' then
                   P := P + 1;
                   Set_Msg_Insertion_Unit_Name (Suffix => False);
-
                else
                   Set_Msg_Insertion_Unit_Name;
                end if;
@@ -2733,7 +2699,12 @@ package body Errout is
                P := P + 1;
 
             when '~' =>
-               Set_Msg_Str (Error_Msg_String (1 .. Error_Msg_Strlen));
+               if P <= Text'Last and then Text (P) = '~' then
+                  P := P + 1;
+                  Set_Msg_Str (Error_Msg_Lang (1 .. Error_Msg_Langlen));
+               else
+                  Set_Msg_Str (Error_Msg_String (1 .. Error_Msg_Strlen));
+               end if;
 
             --  Upper case letter