-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, 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- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
separate (Par)
function Prag (Pragma_Node : Node_Id; Semi : Source_Ptr) return Node_Id is
- Pragma_Name : constant Name_Id := Chars (Pragma_Node);
- Prag_Id : constant Pragma_Id := Get_Pragma_Id (Pragma_Name);
+ Prag_Name : constant Name_Id := Pragma_Name (Pragma_Node);
+ Prag_Id : constant Pragma_Id := Get_Pragma_Id (Prag_Name);
Pragma_Sloc : constant Source_Ptr := Sloc (Pragma_Node);
Arg_Count : Nat;
Arg_Node : Node_Id;
Error_Msg_Name_2 := Name_On;
Error_Msg_Name_3 := Name_Off;
- Error_Msg
- ("argument for pragma% must be% or%", Sloc (Argx));
+ Error_Msg ("argument for pragma% must be% or%", Sloc (Argx));
raise Error_Resync;
end if;
end Check_Arg_Is_On_Or_Off;
elsif Id = Name_No_Dependence then
Set_Restriction_No_Dependence
(Unit => Expr,
- Warn => Prag_Id = Pragma_Restriction_Warnings);
+ Warn => Prag_Id = Pragma_Restriction_Warnings
+ or else Treat_Restrictions_As_Warnings);
end if;
Next (Arg);
end loop;
end Process_Restrictions_Or_Restriction_Warnings;
--- Start if processing for Prag
+-- Start of processing for Prag
begin
- Error_Msg_Name_1 := Pragma_Name;
+ Error_Msg_Name_1 := Prag_Name;
-- Ignore unrecognized pragma. We let Sem post the warning for this, since
-- it is a semantic error, not a syntactic one (we have already checked
if Present (Pragma_Argument_Associations (Pragma_Node)) then
Arg_Node := Arg1;
-
while Arg_Node /= Empty loop
Arg_Count := Arg_Count + 1;
-- Ada_05/Ada_2005 --
---------------------
- -- This pragma must be processed at parse time, since we want to set
+ -- These pragmas must be processed at parse time, since we want to set
-- the Ada version properly at parse time to recognize the appropriate
-- Ada version syntax. However, it is only the zero argument form that
-- must be processed at parse time.
Ada_Version_Explicit := Ada_05;
end if;
+ ---------------------
+ -- Ada_12/Ada_2012 --
+ ---------------------
+
+ -- These pragmas must be processed at parse time, since we want to set
+ -- the Ada version properly at parse time to recognize the appropriate
+ -- Ada version syntax. However, it is only the zero argument form that
+ -- must be processed at parse time.
+
+ when Pragma_Ada_12 | Pragma_Ada_2012 =>
+ if Arg_Count = 0 then
+ Ada_Version := Ada_12;
+ Ada_Version_Explicit := Ada_12;
+ end if;
+
-----------
-- Debug --
-----------
if Chars (Expression (Arg1)) = Name_On then
Extensions_Allowed := True;
- Ada_Version := Ada_Version_Type'Last;
+ Ada_Version := Ada_12;
else
Extensions_Allowed := False;
- Ada_Version := Ada_Version_Type'Min (Ada_Version, Ada_95);
+ Ada_Version := Ada_Version_Explicit;
end if;
- Ada_Version_Explicit := Ada_Version;
-
----------------
-- List (2.8) --
----------------
Expr : Node_Id;
Index : Nat;
- function Get_Fname (Arg : Node_Id) return Name_Id;
+ function Get_Fname (Arg : Node_Id) return File_Name_Type;
-- Process file name from unit name form of pragma
function Get_String_Argument (Arg : Node_Id) return String_Ptr;
-- Process Casing argument of pattern form of pragma
procedure Process_Dot_Replacement (Arg : Node_Id);
- -- Process Dot_Replacement argument of patterm form of pragma
+ -- Process Dot_Replacement argument of pattern form of pragma
---------------
-- Get_Fname --
---------------
- function Get_Fname (Arg : Node_Id) return Name_Id is
+ function Get_Fname (Arg : Node_Id) return File_Name_Type is
begin
String_To_Name_Buffer (Strval (Expression (Arg)));
-- Source_File_Name_Project pragmas.
begin
- if Get_Pragma_Id (Pragma_Name) = Pragma_Source_File_Name then
+ if Prag_Id = Pragma_Source_File_Name then
if Project_File_In_Use = In_Use then
Error_Msg
("pragma Source_File_Name cannot be used " &
-- turn off semantic checking anyway if any parse errors are found.
when Pragma_Source_Reference => Source_Reference : declare
- Fname : Name_Id;
+ Fname : File_Name_Type;
begin
if Arg_Count /= 1 then
and then Num_SRef_Pragmas (Current_Source_File) = 0
and then Operating_Mode /= Check_Syntax
then
- Error_Msg
+ Error_Msg -- CODEFIX
("first % pragma must be first line of file", Pragma_Sloc);
raise Error_Resync;
end if;
Pragma_Sloc);
raise Error_Resync;
else
- Fname := No_Name;
+ Fname := No_File;
end if;
-- File name present
OK := False;
elsif Chars (A) = Name_All_Checks then
- Stylesw.Set_Default_Style_Check_Options;
+ if GNAT_Mode then
+ Stylesw.Set_GNAT_Style_Check_Options;
+ else
+ Stylesw.Set_Default_Style_Check_Options;
+ end if;
elsif Chars (A) = Name_On then
Style_Check := True;
-- The one argument ON/OFF case is processed by the parser, since it may
-- control parser warnings as well as semantic warnings, and in any case
-- we want to be absolutely sure that the range in the warnings table is
- -- set well before any semantic analysis is performed.
+ -- set well before any semantic analysis is performed. Note that we
+ -- ignore this pragma if debug flag -gnatd.i is set.
when Pragma_Warnings =>
- if Arg_Count = 1 then
+ if Arg_Count = 1 and then not Debug_Flag_Dot_I then
Check_No_Identifier (Arg1);
declare
end;
else
- raise Constraint_Error;
+ raise Constraint_Error;
end if;
+ Upper_Half_Encoding :=
+ Wide_Character_Encoding_Method in
+ WC_Upper_Half_Encoding_Method;
+
exception
when Constraint_Error =>
Error_Msg_N ("invalid argument for pragma%", Arg1);
when Pragma_Abort_Defer |
Pragma_Assertion_Policy |
+ Pragma_Assume_No_Invalid_Values |
Pragma_AST_Entry |
Pragma_All_Calls_Remote |
Pragma_Annotate |
Pragma_Atomic |
Pragma_Atomic_Components |
Pragma_Attach_Handler |
+ Pragma_Check |
+ Pragma_Check_Name |
+ Pragma_Check_Policy |
+ Pragma_CIL_Constructor |
+ Pragma_Compile_Time_Error |
Pragma_Compile_Time_Warning |
+ Pragma_Compiler_Unit |
Pragma_Convention_Identifier |
Pragma_CPP_Class |
Pragma_CPP_Constructor |
Pragma_Convention |
Pragma_Debug_Policy |
Pragma_Detect_Blocking |
+ Pragma_Dimension |
Pragma_Discard_Names |
Pragma_Eliminate |
Pragma_Elaborate |
Pragma_Elaborate_All |
Pragma_Elaborate_Body |
Pragma_Elaboration_Checks |
- Pragma_Explicit_Overriding |
Pragma_Export |
Pragma_Export_Exception |
Pragma_Export_Function |
Pragma_Extend_System |
Pragma_External |
Pragma_External_Name_Casing |
+ Pragma_Favor_Top_Level |
+ Pragma_Fast_Math |
Pragma_Finalize_Storage_Only |
Pragma_Float_Representation |
Pragma_Ident |
+ Pragma_Implemented |
+ Pragma_Implicit_Packing |
Pragma_Import |
Pragma_Import_Exception |
Pragma_Import_Function |
Pragma_Import_Object |
Pragma_Import_Procedure |
Pragma_Import_Valued_Procedure |
+ Pragma_Independent |
+ Pragma_Independent_Components |
Pragma_Initialize_Scalars |
Pragma_Inline |
Pragma_Inline_Always |
Pragma_Main |
Pragma_Main_Storage |
Pragma_Memory_Size |
+ Pragma_No_Body |
Pragma_No_Return |
- Pragma_Obsolescent |
Pragma_No_Run_Time |
Pragma_No_Strict_Aliasing |
Pragma_Normalize_Scalars |
+ Pragma_Obsolescent |
+ Pragma_Ordered |
Pragma_Optimize |
- Pragma_Optional_Overriding |
+ Pragma_Optimize_Alignment |
Pragma_Pack |
Pragma_Passive |
Pragma_Preelaborable_Initialization |
Pragma_Polling |
Pragma_Persistent_BSS |
+ Pragma_Postcondition |
+ Pragma_Precondition |
Pragma_Preelaborate |
Pragma_Preelaborate_05 |
Pragma_Priority |
Pragma_Pure_05 |
Pragma_Pure_Function |
Pragma_Queuing_Policy |
+ Pragma_Relative_Deadline |
Pragma_Remote_Call_Interface |
Pragma_Remote_Types |
Pragma_Restricted_Run_Time |
Pragma_Share_Generic |
Pragma_Shared |
Pragma_Shared_Passive |
+ Pragma_Short_Circuit_And_Or |
+ Pragma_Short_Descriptors |
Pragma_Storage_Size |
Pragma_Storage_Unit |
+ Pragma_Static_Elaboration_Desired |
Pragma_Stream_Convert |
Pragma_Subtitle |
Pragma_Suppress |
Pragma_Task_Info |
Pragma_Task_Name |
Pragma_Task_Storage |
- Pragma_Thread_Body |
+ Pragma_Thread_Local_Storage |
Pragma_Time_Slice |
Pragma_Title |
Pragma_Unchecked_Union |
Pragma_Unimplemented_Unit |
+ Pragma_Universal_Aliasing |
Pragma_Universal_Data |
+ Pragma_Unmodified |
Pragma_Unreferenced |
+ Pragma_Unreferenced_Objects |
Pragma_Unreserve_All_Interrupts |
Pragma_Unsuppress |
Pragma_Use_VADS_Size |
OSDN Git Service
