diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 11 | ||||
| -rw-r--r-- | gcc/ada/lib-xref.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 44 |
3 files changed, 56 insertions, 13 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c547272..46faa3da 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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 diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index 11c2d06..2ebdb14 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -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 diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index bd236e5..49fcf2f 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -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; |