diff options
Diffstat (limited to 'gcc/ada/sem_prag.adb')
| -rw-r--r-- | gcc/ada/sem_prag.adb | 112 |
1 files changed, 92 insertions, 20 deletions
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 6ece74120d0..408024b3715 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2004, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005, 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- -- @@ -4306,14 +4306,32 @@ package body Sem_Prag is ------------ -- pragma Ada_05; + -- pragma Ada_05 (LOCAL_NAME); -- Note: this pragma also has some specific processing in Par.Prag - -- because we want to set the Ada 83 version mode during parsing. + -- because we want to set the Ada 2005 version mode during parsing. + + when Pragma_Ada_05 => declare + E_Id : Node_Id; - when Pragma_Ada_05 => + begin GNAT_Pragma; - Ada_Version := Ada_05; - Check_Arg_Count (0); + + if Arg_Count = 1 then + Check_Arg_Is_Local_Name (Arg1); + E_Id := Expression (Arg1); + + if Etype (E_Id) = Any_Type then + return; + end if; + + Set_Is_Ada_2005 (Entity (E_Id)); + + else + Ada_Version := Ada_05; + Check_Arg_Count (0); + end if; + end; ---------------------- -- All_Calls_Remote -- @@ -5623,7 +5641,19 @@ package body Sem_Prag is then Set_Elaborate_Present (Citem, True); Set_Unit_Name (Expression (Arg), Name (Citem)); - Set_Suppress_Elaboration_Warnings (Entity (Name (Citem))); + + -- With the pragma present, elaboration calls on + -- subprograms from the named unit need no further + -- checks, as long as the pragma appears in the current + -- compilation unit. If the pragma appears in some unit + -- in the context, there might still be a need for an + -- Elaborate_All_Desirable from the current compilation + -- to the the named unit, so we keep the check enabled. + + if In_Extended_Main_Source_Unit (N) then + Set_Suppress_Elaboration_Warnings + (Entity (Name (Citem))); + end if; exit Inner; end if; @@ -5708,7 +5738,15 @@ package body Sem_Prag is then Set_Elaborate_All_Present (Citem, True); Set_Unit_Name (Expression (Arg), Name (Citem)); - Set_Suppress_Elaboration_Warnings (Entity (Name (Citem))); + + -- Suppress warnings and elaboration checks on the named + -- unit if the pragma is in the current compilation, as + -- for pragma Elaborate. + + if In_Extended_Main_Source_Unit (N) then + Set_Suppress_Elaboration_Warnings + (Entity (Name (Citem))); + end if; exit Innr; end if; @@ -7935,21 +7973,63 @@ package body Sem_Prag is -- pragma Obsolescent [(static_string_EXPRESSION)]; when Pragma_Obsolescent => Obsolescent : declare + Subp : Node_Or_Entity_Id; + S : String_Id; + begin GNAT_Pragma; Check_At_Most_N_Arguments (1); Check_No_Identifiers; - if Arg_Count = 1 then - Check_Arg_Is_Static_Expression (Arg1, Standard_String); - end if; + -- Check OK placement - if No (Prev (N)) - or else (Nkind (Prev (N))) /= N_Subprogram_Declaration + -- First possibility is within a declarative region, where the + -- pragma immediately follows a subprogram declaration. + + if Present (Prev (N)) then + Subp := Prev (N); + + -- Second possibility, stand alone subprogram declaration with the + -- pragma immediately following the declaration. + + elsif No (Prev (N)) + and then Nkind (Parent (N)) = N_Compilation_Unit_Aux then + Subp := Unit (Parent (Parent (N))); + + -- Any other possibility is a misplacement + + else + Subp := Empty; + end if; + + -- Check correct placement + + if Nkind (Subp) /= N_Subprogram_Declaration then Error_Pragma ("pragma% misplaced, must immediately " & "follow subprogram spec"); + + -- If OK placement, set flag and acquire argument + + else + Subp := Defining_Entity (Subp); + Set_Is_Obsolescent (Subp); + + if Arg_Count = 1 then + Check_Arg_Is_Static_Expression (Arg1, Standard_String); + S := Strval (Expression (Arg1)); + + for J in 1 .. String_Length (S) loop + if not In_Character_Range (Get_String_Char (S, J)) then + Error_Pragma_Arg + ("pragma% argument does not allow wide characters", + Arg1); + end if; + end loop; + + Set_Obsolescent_Warning (Subp, Expression (Arg1)); + end if; end if; end Obsolescent; @@ -8023,13 +8103,6 @@ package body Sem_Prag is when Pragma_Optional_Overriding => Error_Msg_N ("pragma must appear immediately after subprogram", N); - ---------------- - -- Overriding -- - ---------------- - - when Pragma_Overriding => - Error_Msg_N ("pragma must appear immediately after subprogram", N); - ---------- -- Pack -- ---------- @@ -10325,7 +10398,6 @@ package body Sem_Prag is Pragma_Obsolescent => 0, Pragma_Optimize => -1, Pragma_Optional_Overriding => -1, - Pragma_Overriding => -1, Pragma_Pack => 0, Pragma_Page => -1, Pragma_Passive => -1, |