+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,
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
-- --
-- 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- --
-- 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';
-- 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
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,
-- 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);
-- 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);
-- 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);
-- 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
-- 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;
---------------
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
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;
-- 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
-- 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
projects / gcc.git / commitdiff