Skip to content

R
riscv-gcc-1
Commit 6577bef9 by Arnaud Charlet
Options

[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
Showing with 102 additions and 83 deletions
gcc/ada/ChangeLog
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>
* exp_ch6.adb (Expand_N_Subprogram_Body): When compiling with
......
gcc/ada/err_vars.ads
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -54,7 +54,7 @@ package Err_Vars is
-- variables are not reset by calls to the error message routines, so the
-- 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
-- description of the } insertion character. Note that this value does
-- note get reset by any Error_Msg call, so the caller is responsible
......
gcc/ada/opt.ads
......@@ -968,7 +968,7 @@ package Opt is
-- GNATMAKE
-- Set to True if minimal recompilation mode requested
Multiple_Unit_Index : Int;
Multiple_Unit_Index : Int := 0;
-- GNAT
-- 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
......
gcc/ada/sem_prag.adb
......@@ -181,6 +181,16 @@ package body Sem_Prag is
-- original one, following the renaming chain) is returned. Otherwise the
-- 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);
-- Preanalyze the boolean expressions in the Requires and Ensures arguments
-- of a Test_Case pragma if present (possibly Empty). We treat these as
......@@ -2869,7 +2879,7 @@ package body Sem_Prag is
-- Get name from corresponding aspect
Error_Msg_Name_1 := Effective_Name (N);
Error_Msg_Name_1 := Original_Name (N);
end if;
end Fix_Error;
......@@ -6749,7 +6759,7 @@ package body Sem_Prag is
-- Here to start processing for recognized pragma
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
-- an aspect, since we already dealt with the Disable case, and we set
......@@ -17990,7 +18000,7 @@ package body Sem_Prag is
PP : Node_Id;
Policy : Name_Id;
Ename : constant Name_Id := Effective_Name (N);
Ename : constant Name_Id := Original_Name (N);
begin
-- No effect if not valid assertion kind name
......@@ -18050,66 +18060,6 @@ package body Sem_Prag is
Name_Priority_Specific_Dispatching);
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 --
-------------------------
......@@ -18664,6 +18614,66 @@ package body Sem_Prag is
end if;
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 --
-------------------------
......
gcc/ada/sem_prag.ads
......@@ -104,16 +104,6 @@ package Sem_Prag is
-- True have their analysis delayed until after the main program is parsed
-- 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;
-- Initializes data structures used for pragma processing. Must be called
-- before analyzing each new main source program.
......
gcc/ada/sem_util.adb
......@@ -83,7 +83,7 @@ package body Sem_Util is
NCT_Hash_Tables_Used : Boolean := False;
-- 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
NCT_Hash_Table_Setup : Boolean := False;
......
gcc/ada/set_targ.ads
......@@ -98,7 +98,7 @@ package Set_Targ is
end record;
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
-----------------
......
gcc/ada/stylesw.adb
......@@ -6,7 +6,7 @@
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -161,10 +161,12 @@ package body Stylesw is
Add ('b', Style_Check_Blanks_At_End);
Add ('B', Style_Check_Boolean_And_Or);
if Style_Check_Comments_Spacing = 2 then
Add ('c', Style_Check_Comments);
elsif Style_Check_Comments_Spacing = 1 then
Add ('C', Style_Check_Comments);
if Style_Check_Comments then
if Style_Check_Comments_Spacing = 2 then
Add ('c', Style_Check_Comments);
elsif Style_Check_Comments_Spacing = 1 then
Add ('C', Style_Check_Comments);
end if;
end if;
Add ('d', Style_Check_DOS_Line_Terminator);
......
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