Skip to content

R
riscv-gcc-1
Commit b2c3b537 by Arnaud Charlet
Options

[multiple changes] 

2013-04-22  Yannick Moy  <moy@adacore.com>

	* exp_prag.adb, sinfo.ads, sem_prag.ads: Minor correction of typos in
	comments.
	* sem_ch6.adb (Expand_Contract_Cases): Add location to message.

2013-04-22  Thomas Quinot  <quinot@adacore.com>

	* sem_prag.adb (Fix_Error): For a pragma rewritten from another
	pragma, fix up error message to include original pragma name.
	* par_sco.adb: Minor reformatting.

From-SVN: r198133
parent 1a83142e
Showing with 39 additions and 19 deletions
gcc/ada/ChangeLog
2013-04-22 Yannick Moy <moy@adacore.com>
* exp_prag.adb, sinfo.ads, sem_prag.ads: Minor correction of typos in
comments.
* sem_ch6.adb (Expand_Contract_Cases): Add location to message.
2013-04-22 Thomas Quinot <quinot@adacore.com>
* sem_prag.adb (Fix_Error): For a pragma rewritten from another
pragma, fix up error message to include original pragma name.
* par_sco.adb: Minor reformatting.
2013-04-22 Robert Dewar <dewar@adacore.com>
* sem_prag.adb, sem_util.adb, sem_util.ads, sem_res.adb, exp_ch6.adb,
......
gcc/ada/exp_prag.adb
......@@ -1059,7 +1059,7 @@ package body Exp_Prag is
end if;
end Process_Variant;
-- Start of processing for Expand_Pragma_Loop_Assertion
-- Start of processing for Expand_Pragma_Loop_Variant
begin
-- Locate the enclosing loop for which this assertion applies. In the
......
gcc/ada/par_sco.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2009-2012, Free Software Foundation, Inc. --
-- Copyright (C) 2009-2013, 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- --
......@@ -1455,11 +1455,11 @@ package body Par_SCO is
-- specification. The corresponding pragma will have the same
-- sloc.
when Aspect_Pre |
Aspect_Precondition |
Aspect_Post |
Aspect_Postcondition |
Aspect_Invariant =>
when Aspect_Pre |
Aspect_Precondition |
Aspect_Post |
Aspect_Postcondition |
Aspect_Invariant =>
C1 := 'a';
......
gcc/ada/sem_ch6.adb
......@@ -11352,7 +11352,7 @@ package body Sem_Ch6 is
-- end if;
-- if Count = 0 then
-- raise Assertion_Error with "contract cases incomplete";
-- raise Assertion_Error with "xxx contract cases incomplete";
-- <or>
-- Flag_N+1 := True; -- when "others" present
......@@ -11712,11 +11712,12 @@ package body Sem_Ch6 is
CG_Stmts := New_List (Set (Others_Flag));
-- Generate:
-- raise Assetion_Error with "contract cases incomplete";
-- raise Assertion_Error with "xxx contract cases incomplete";
else
Start_String;
Store_String_Chars ("contract cases incomplete");
Store_String_Chars (Build_Location_String (Loc));
Store_String_Chars (" contract cases incomplete");
CG_Stmts := New_List (
Make_Procedure_Call_Statement (Loc,
......
gcc/ada/sem_prag.adb
......@@ -768,7 +768,7 @@ package body Sem_Prag is
-- Outputs error message for current pragma. The message contains a %
-- that will be replaced with the pragma name, and the flag is placed
-- on the pragma itself. Pragma_Exit is then raised. Note: this routine
-- calls Fix_Error (see spec of that function for details).
-- calls Fix_Error (see spec of that procedure for details).
procedure Error_Pragma_Arg (Msg : String; Arg : Node_Id);
pragma No_Return (Error_Pragma_Arg);
......@@ -780,7 +780,7 @@ package body Sem_Prag is
-- message is placed using Error_Msg_N, so the message may also contain
-- an & insertion character which will reference the given Arg value.
-- After placing the message, Pragma_Exit is raised. Note: this routine
-- calls Fix_Error (see spec of that function for details).
-- calls Fix_Error (see spec of that procedure for details).
procedure Error_Pragma_Arg (Msg1, Msg2 : String; Arg : Node_Id);
pragma No_Return (Error_Pragma_Arg);
......@@ -797,7 +797,7 @@ package body Sem_Prag is
-- the message may also contain an & insertion character which will
-- reference the identifier. After placing the message, Pragma_Exit
-- is raised. Note: this routine calls Fix_Error (see spec of that
-- function for details).
-- procedure for details).
procedure Error_Pragma_Ref (Msg : String; Ref : Entity_Id);
pragma No_Return (Error_Pragma_Ref);
......@@ -805,7 +805,7 @@ package body Sem_Prag is
-- a % that will be replaced with the pragma name. The parameter Ref
-- must be an entity whose name can be referenced by & and sloc by #.
-- After placing the message, Pragma_Exit is raised. Note: this routine
-- calls Fix_Error (see spec of that function for details).
-- calls Fix_Error (see spec of that procedure for details).
function Find_Lib_Unit_Name return Entity_Id;
-- Used for a library unit pragma to find the entity to which the
......@@ -831,6 +831,8 @@ package body Sem_Prag is
-- comes from an aspect, each such "pragma" substring is replaced with
-- the characters "aspect", and if Error_Msg_Name_1 is Name_Precondition
-- (resp Name_Postcondition) it is changed to Name_Pre (resp Name_Post).
-- In addition, if the current pragma results from rewriting another
-- pragma, Error_Msg_Name_1 is set to the original pragma name.
procedure Gather_Associations
(Names : Name_List;
......@@ -2862,6 +2864,8 @@ package body Sem_Prag is
---------------
procedure Fix_Error (Msg : in out String) is
Orig : constant Node_Id := Original_Node (N);
begin
if From_Aspect_Specification (N) then
for J in Msg'First .. Msg'Last - 5 loop
......@@ -2875,6 +2879,9 @@ package body Sem_Prag is
elsif Error_Msg_Name_1 = Name_Postcondition then
Error_Msg_Name_1 := Name_Post;
end if;
elsif Orig /= N and then Nkind (Orig) = N_Pragma then
Error_Msg_Name_1 := Pragma_Name (Orig);
end if;
end Fix_Error;
......
gcc/ada/sem_prag.ads
......@@ -55,7 +55,7 @@ package Sem_Prag is
-- in Sem "Handling of Default and Per-Object Expressions...").
function Check_Kind (Nam : Name_Id) return Name_Id;
-- This function is used in connection with pragmas Assertion, Check,
-- This function is used in connection with pragmas Assert, Check,
-- and assertion aspects and pragmas, to determine if Check pragmas
-- (or corresponding assertion aspects or pragmas) are currently active
-- as determined by the presence of -gnata on the command line (which
......
gcc/ada/sinfo.ads
......@@ -1325,10 +1325,10 @@ package Sinfo is
-- gives a policy for the aspect or pragma, then there are two cases. For
-- an assertion aspect or pragma (one of the assertion kinds allowed in
-- an Assertion_Policy pragma), then Is_Ignored is set if assertions are
-- ignored because of the use of a -gnata switch. For any other aspects
-- or pragmas, the flag is off. If this flag is set, the aspect/pragma
-- is fully analyzed and checked for other syntactic/semantic errors,
-- but it does not have any semantic effect.
-- ignored because of the absence of a -gnata switch. For any other
-- aspects or pragmas, the flag is off. If this flag is set, the
-- aspect/pragma is fully analyzed and checked for other
-- syntactic/semantic errors, but it does not have any semantic effect.
-- Is_In_Discriminant_Check (Flag11-Sem)
-- This flag is present in a selected component, and is used to indicate
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment