OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2015-02-05  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Check_Pragma_Conformance): Add
	local variable Arg. Ensure that all errors are associated with
	the pragma if it appears without an argument. Add comments on
	various cases.

2015-02-05  Robert Dewar  <dewar@adacore.com>

	* lib-xref.adb: Minor reformatting.

From-SVN: r220442
This commit is contained in:
Arnaud Charlet 2015-02-05 12:10:42 +01:00
parent 27d1630641
commit 57979da1a8
3 changed files with 56 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/ada/ChangeLog
View File

@ -1,3 +1,14 @@
2015-02-05 Hristian Kirtchev <kirtchev@adacore.com>
* sem_prag.adb (Check_Pragma_Conformance): Add
local variable Arg. Ensure that all errors are associated with
the pragma if it appears without an argument. Add comments on
various cases.
2015-02-05 Robert Dewar <dewar@adacore.com>
* lib-xref.adb: Minor reformatting.
2015-02-05 Tristan Gingold <gingold@adacore.com>
PR ada/64349da/64349

14
gcc/ada/lib-xref.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2014, Free Software Foundation, Inc. --
-- Copyright (C) 1998-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- --
@ -415,6 +415,7 @@ package body Lib.Xref is
function Get_Through_Renamings (E : Entity_Id) return Entity_Id is
Result : Entity_Id := E;
begin
while Present (Result)
and then Is_Object (Result)
@ -422,6 +423,7 @@ package body Lib.Xref is
loop
Result := Get_Enclosing_Object (Renamed_Object (Result));
end loop;
return Result;
end Get_Through_Renamings;
@ -646,11 +648,11 @@ package body Lib.Xref is
-- initialized type.
if not In_Extended_Main_Source_Unit (N) then
if Typ = 'e'
or else Typ = 'I'
or else Typ = 'p'
or else Typ = 'i'
or else Typ = 'k'
if Typ = 'e' or else
Typ = 'I' or else
Typ = 'p' or else
Typ = 'i' or else
Typ = 'k'
or else (Typ = 'b' and then Is_Generic_Instance (E))
-- Allow the generation of references to reads, writes and calls

44
gcc/ada/sem_prag.adb
View File

@ -19615,42 +19615,72 @@ package body Sem_Prag is
Entity_Pragma : Node_Id;
Entity : Entity_Id)
is
Arg : Node_Id := Arg1;
begin
-- The current pragma may appear without an argument. If this
-- is the case, associate all error messages with the pragma
-- itself.
if No (Arg) then
Arg := N;
end if;
-- The mode of the current pragma is compared against that of
-- an enclosing context.
if Present (Context_Pragma) then
pragma Assert (Nkind (Context_Pragma) = N_Pragma);
-- New mode less restrictive than the established mode
-- Issue an error if the new mode is less restrictive than
-- that of the context.
if Get_SPARK_Mode_From_Pragma (Context_Pragma) = Off
and then Get_SPARK_Mode_From_Pragma (N) = On
then
Error_Msg_N
("cannot change SPARK_Mode from Off to On", Arg1);
("cannot change SPARK_Mode from Off to On", Arg);
Error_Msg_Sloc := Sloc (SPARK_Mode_Pragma);
Error_Msg_N ("\SPARK_Mode was set to Off#", Arg1);
Error_Msg_N ("\SPARK_Mode was set to Off#", Arg);
raise Pragma_Exit;
end if;
end if;
-- The mode of the current pragma is compared against that of
-- an initial package/subprogram declaration.
if Present (Entity) then
-- Both the initial declaration and the completion carry
-- SPARK_Mode pragmas.
if Present (Entity_Pragma) then
pragma Assert (Nkind (Entity_Pragma) = N_Pragma);
-- Issue an error if the new mode is less restrictive
-- than that of the initial declaration.
if Get_SPARK_Mode_From_Pragma (Entity_Pragma) = Off
and then Get_SPARK_Mode_From_Pragma (N) = On
then
Error_Msg_N ("incorrect use of SPARK_Mode", Arg1);
Error_Msg_N ("incorrect use of SPARK_Mode", Arg);
Error_Msg_Sloc := Sloc (Entity_Pragma);
Error_Msg_NE
("\value Off was set for SPARK_Mode on&#",
Arg1, Entity);
Arg, Entity);
raise Pragma_Exit;
end if;
-- Otherwise the initial declaration lacks a SPARK_Mode
-- pragma in which case the current pragma is illegal as
-- it cannot "complete".
else
Error_Msg_N ("incorrect use of SPARK_Mode", Arg1);
Error_Msg_N ("incorrect use of SPARK_Mode", Arg);
Error_Msg_Sloc := Sloc (Entity);
Error_Msg_NE
("\no value was set for SPARK_Mode on&#",
Arg1, Entity);
Arg, Entity);
raise Pragma_Exit;
end if;
end if;