Commit 6577bef9 by Arnaud Charlet

[multiple changes]

2013-04-23  Yannick Moy  <moy@adacore.com>

	* err_vars.ads (Error_Msg_Qual_Level): Set variable to zero
	at declaration.
	* opt.ads (Multiple_Unit_Index): Set variable to zero at declaration.
	* sem_util.adb (NCT_Table_Entries): Set variable to zero at declaration.
	* set_targ.ads (Num_FPT_Modes): Set variable to zero at declaration.
	* stylesw.adb (Save_Style_Check_Options): Protect testing the
	value of Style_Check_Comments_Spacing by a previous test that
	Style_Check_Comments is True.

2013-04-23  Thomas Quinot  <quinot@adacore.com>

	* sem_prag.adb, sem_prag.ads (Effective_Name): Rename to
	Original_Name, and move declaration to package body as this
	subprogram is not used from outside. Also clarify documentation.

From-SVN: r198195
parent 05c064c1
2013-04-23 Yannick Moy <moy@adacore.com>
* err_vars.ads (Error_Msg_Qual_Level): Set variable to zero
at declaration.
* opt.ads (Multiple_Unit_Index): Set variable to zero at declaration.
* sem_util.adb (NCT_Table_Entries): Set variable to zero at declaration.
* set_targ.ads (Num_FPT_Modes): Set variable to zero at declaration.
* stylesw.adb (Save_Style_Check_Options): Protect testing the
value of Style_Check_Comments_Spacing by a previous test that
Style_Check_Comments is True.
2013-04-23 Thomas Quinot <quinot@adacore.com>
* sem_prag.adb, sem_prag.ads (Effective_Name): Rename to
Original_Name, and move declaration to package body as this
subprogram is not used from outside. Also clarify documentation.
2013-04-23 Ed Schonberg <schonberg@adacore.com> 2013-04-23 Ed Schonberg <schonberg@adacore.com>
* exp_ch6.adb (Expand_N_Subprogram_Body): When compiling with * exp_ch6.adb (Expand_N_Subprogram_Body): When compiling with
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -54,7 +54,7 @@ package Err_Vars is ...@@ -54,7 +54,7 @@ package Err_Vars is
-- variables are not reset by calls to the error message routines, so the -- variables are not reset by calls to the error message routines, so the
-- caller is responsible for resetting the default behavior after use. -- caller is responsible for resetting the default behavior after use.
Error_Msg_Qual_Level : Int; Error_Msg_Qual_Level : Int := 0;
-- Number of levels of qualification required for type name (see the -- Number of levels of qualification required for type name (see the
-- description of the } insertion character. Note that this value does -- description of the } insertion character. Note that this value does
-- note get reset by any Error_Msg call, so the caller is responsible -- note get reset by any Error_Msg call, so the caller is responsible
......
...@@ -968,7 +968,7 @@ package Opt is ...@@ -968,7 +968,7 @@ package Opt is
-- GNATMAKE -- GNATMAKE
-- Set to True if minimal recompilation mode requested -- Set to True if minimal recompilation mode requested
Multiple_Unit_Index : Int; Multiple_Unit_Index : Int := 0;
-- GNAT -- GNAT
-- This is set non-zero if the current unit is being compiled in multiple -- This is set non-zero if the current unit is being compiled in multiple
-- unit per file mode, meaning that the current unit is selected from the -- unit per file mode, meaning that the current unit is selected from the
......
...@@ -181,6 +181,16 @@ package body Sem_Prag is ...@@ -181,6 +181,16 @@ package body Sem_Prag is
-- original one, following the renaming chain) is returned. Otherwise the -- original one, following the renaming chain) is returned. Otherwise the
-- entity is returned unchanged. Should be in Einfo??? -- entity is returned unchanged. Should be in Einfo???
function Original_Name (N : Node_Id) return Name_Id;
-- N is a pragma node or aspect specification node. This function returns
-- the name of the pragma or aspect in original source form, taking into
-- account possible rewrites, and also cases where a pragma comes from an
-- aspect (in such cases, the name can be different from the pragma name,
-- e.g. a Pre aspect generates a Precondition pragma). This also deals with
-- the presence of 'Class, which results in one of the special names
-- Name_uPre, Name_uPost, Name_uInvariant, or Name_uType_Invariant being
-- returned to represent the corresponding aspects with x'Class names.
procedure Preanalyze_CTC_Args (N, Arg_Req, Arg_Ens : Node_Id); procedure Preanalyze_CTC_Args (N, Arg_Req, Arg_Ens : Node_Id);
-- Preanalyze the boolean expressions in the Requires and Ensures arguments -- Preanalyze the boolean expressions in the Requires and Ensures arguments
-- of a Test_Case pragma if present (possibly Empty). We treat these as -- of a Test_Case pragma if present (possibly Empty). We treat these as
...@@ -2869,7 +2879,7 @@ package body Sem_Prag is ...@@ -2869,7 +2879,7 @@ package body Sem_Prag is
-- Get name from corresponding aspect -- Get name from corresponding aspect
Error_Msg_Name_1 := Effective_Name (N); Error_Msg_Name_1 := Original_Name (N);
end if; end if;
end Fix_Error; end Fix_Error;
...@@ -6749,7 +6759,7 @@ package body Sem_Prag is ...@@ -6749,7 +6759,7 @@ package body Sem_Prag is
-- Here to start processing for recognized pragma -- Here to start processing for recognized pragma
Prag_Id := Get_Pragma_Id (Pname); Prag_Id := Get_Pragma_Id (Pname);
Pname := Effective_Name (N); Pname := Original_Name (N);
-- Check applicable policy. We skip this for a pragma that came from -- Check applicable policy. We skip this for a pragma that came from
-- an aspect, since we already dealt with the Disable case, and we set -- an aspect, since we already dealt with the Disable case, and we set
...@@ -17990,7 +18000,7 @@ package body Sem_Prag is ...@@ -17990,7 +18000,7 @@ package body Sem_Prag is
PP : Node_Id; PP : Node_Id;
Policy : Name_Id; Policy : Name_Id;
Ename : constant Name_Id := Effective_Name (N); Ename : constant Name_Id := Original_Name (N);
begin begin
-- No effect if not valid assertion kind name -- No effect if not valid assertion kind name
...@@ -18050,66 +18060,6 @@ package body Sem_Prag is ...@@ -18050,66 +18060,6 @@ package body Sem_Prag is
Name_Priority_Specific_Dispatching); Name_Priority_Specific_Dispatching);
end Delay_Config_Pragma_Analyze; end Delay_Config_Pragma_Analyze;
--------------------
-- Effective_Name --
--------------------
function Effective_Name (N : Node_Id) return Name_Id is
Pras : Node_Id;
Name : Name_Id;
begin
pragma Assert (Nkind_In (N, N_Aspect_Specification, N_Pragma));
Pras := N;
if Is_Rewrite_Substitution (Pras)
and then Nkind (Original_Node (Pras)) = N_Pragma
then
Pras := Original_Node (Pras);
end if;
-- Case where we came from aspect specication
if Nkind (Pras) = N_Pragma and then From_Aspect_Specification (Pras) then
Pras := Corresponding_Aspect (Pras);
end if;
-- Get name from aspect or pragma
if Nkind (Pras) = N_Pragma then
Name := Pragma_Name (Pras);
else
Name := Chars (Identifier (Pras));
end if;
-- Deal with 'Class
if Class_Present (Pras) then
case Name is
-- Names that need converting to special _xxx form
when Name_Pre => Name := Name_uPre;
when Name_Post => Name := Name_uPost;
when Name_Invariant => Name := Name_uInvariant;
when Name_Type_Invariant => Name := Name_uType_Invariant;
-- Names already in special _xxx form (leave them alone)
when Name_uPre => null;
when Name_uPost => null;
when Name_uInvariant => null;
when Name_uType_Invariant => null;
-- Anything else is impossible with Class_Present set True
when others => raise Program_Error;
end case;
end if;
return Name;
end Effective_Name;
------------------------- -------------------------
-- Get_Base_Subprogram -- -- Get_Base_Subprogram --
------------------------- -------------------------
...@@ -18664,6 +18614,66 @@ package body Sem_Prag is ...@@ -18664,6 +18614,66 @@ package body Sem_Prag is
end if; end if;
end Make_Aspect_For_PPC_In_Gen_Sub_Decl; end Make_Aspect_For_PPC_In_Gen_Sub_Decl;
-------------------
-- Original_Name --
-------------------
function Original_Name (N : Node_Id) return Name_Id is
Pras : Node_Id;
Name : Name_Id;
begin
pragma Assert (Nkind_In (N, N_Aspect_Specification, N_Pragma));
Pras := N;
if Is_Rewrite_Substitution (Pras)
and then Nkind (Original_Node (Pras)) = N_Pragma
then
Pras := Original_Node (Pras);
end if;
-- Case where we came from aspect specication
if Nkind (Pras) = N_Pragma and then From_Aspect_Specification (Pras) then
Pras := Corresponding_Aspect (Pras);
end if;
-- Get name from aspect or pragma
if Nkind (Pras) = N_Pragma then
Name := Pragma_Name (Pras);
else
Name := Chars (Identifier (Pras));
end if;
-- Deal with 'Class
if Class_Present (Pras) then
case Name is
-- Names that need converting to special _xxx form
when Name_Pre => Name := Name_uPre;
when Name_Post => Name := Name_uPost;
when Name_Invariant => Name := Name_uInvariant;
when Name_Type_Invariant => Name := Name_uType_Invariant;
-- Names already in special _xxx form (leave them alone)
when Name_uPre => null;
when Name_uPost => null;
when Name_uInvariant => null;
when Name_uType_Invariant => null;
-- Anything else is impossible with Class_Present set True
when others => raise Program_Error;
end case;
end if;
return Name;
end Original_Name;
------------------------- -------------------------
-- Preanalyze_CTC_Args -- -- Preanalyze_CTC_Args --
------------------------- -------------------------
......
...@@ -104,16 +104,6 @@ package Sem_Prag is ...@@ -104,16 +104,6 @@ package Sem_Prag is
-- True have their analysis delayed until after the main program is parsed -- True have their analysis delayed until after the main program is parsed
-- and analyzed. -- and analyzed.
function Effective_Name (N : Node_Id) return Name_Id;
-- N is a pragma node or aspect specification node. This function returns
-- the name of the pragma or aspect, taking into account possible rewrites,
-- and also cases where a pragma comes from an aspect (in such cases,
-- the name can be different from the pragma name, e.g. Pre generates
-- a Precondition pragma). This also deals with the presence of 'Class
-- which results in one of the special names Name_uPre, Name_uPost,
-- Name_uInvariant, or Name_uType_Invariant being returned to represent
-- the corresponding aspects with x'Class names.
procedure Initialize; procedure Initialize;
-- Initializes data structures used for pragma processing. Must be called -- Initializes data structures used for pragma processing. Must be called
-- before analyzing each new main source program. -- before analyzing each new main source program.
......
...@@ -83,7 +83,7 @@ package body Sem_Util is ...@@ -83,7 +83,7 @@ package body Sem_Util is
NCT_Hash_Tables_Used : Boolean := False; NCT_Hash_Tables_Used : Boolean := False;
-- Set to True if hash tables are in use -- Set to True if hash tables are in use
NCT_Table_Entries : Nat; NCT_Table_Entries : Nat := 0;
-- Count entries in table to see if threshold is reached -- Count entries in table to see if threshold is reached
NCT_Hash_Table_Setup : Boolean := False; NCT_Hash_Table_Setup : Boolean := False;
......
...@@ -98,7 +98,7 @@ package Set_Targ is ...@@ -98,7 +98,7 @@ package Set_Targ is
end record; end record;
FPT_Mode_Table : array (1 .. 1000) of FPT_Mode_Entry; FPT_Mode_Table : array (1 .. 1000) of FPT_Mode_Entry;
Num_FPT_Modes : Natural; Num_FPT_Modes : Natural := 0;
-- Table containing the supported modes and number of entries -- Table containing the supported modes and number of entries
----------------- -----------------
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -161,11 +161,13 @@ package body Stylesw is ...@@ -161,11 +161,13 @@ package body Stylesw is
Add ('b', Style_Check_Blanks_At_End); Add ('b', Style_Check_Blanks_At_End);
Add ('B', Style_Check_Boolean_And_Or); Add ('B', Style_Check_Boolean_And_Or);
if Style_Check_Comments then
if Style_Check_Comments_Spacing = 2 then if Style_Check_Comments_Spacing = 2 then
Add ('c', Style_Check_Comments); Add ('c', Style_Check_Comments);
elsif Style_Check_Comments_Spacing = 1 then elsif Style_Check_Comments_Spacing = 1 then
Add ('C', Style_Check_Comments); Add ('C', Style_Check_Comments);
end if; end if;
end if;
Add ('d', Style_Check_DOS_Line_Terminator); Add ('d', Style_Check_DOS_Line_Terminator);
Add ('e', Style_Check_End_Labels); Add ('e', Style_Check_End_Labels);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment