mirrors/gcc
0
0
Fork 0
mirror of https://gcc.gnu.org/git/gcc.git synced 2024-12-28 13:34:59 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2013-02-06  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch6.adb (Check_For_Primitive_Subprogram): Test for
	the special case of a user-defined equality that overrides
	the predefined equality of a nonderived type declared in a
	declarative part.
	* sem_util.adb (Collect_Primitive_Operations): Add test for
	Is_Primitive when looping over the subprograms following a type,
	to catch the case of primitives such as a user-defined equality,
	which otherwise won't be found when the type is not a derived
	type and is declared in a declarative part.

2013-02-06  Vincent Celier  <celier@adacore.com>

	* prj-conf.adb (Check_Target): Always return True when Target
	is empty (Get_Or_Create_Configuration_File.Get_Project_Target):
	New procedure to get the value of attribute Target in the main
	project.
	(Get_Or_Create_Configuration_File.Do_Autoconf): No
	need to get the value of attribute Target in the main project.
	(Get_Or_Create_Configuration_File): Call Get_Project_Target and
	use the target fom this call.

2013-02-06  Eric Botcazou  <ebotcazou@adacore.com>

	* erroutc.adb (Validate_Specific_Warning): Do not issue the
	warning about an ineffective Pragma Warnings for -Wxxx warnings.
	* sem_prag.adb (Analyze_Pragma) <Warnings>: Accept -Wxxx warnings.
	* gnat_rm.texi (Pragma Warnings): Document coordination with
	warnings of the GCC back-end.

From-SVN: r195786
This commit is contained in:
Arnaud Charlet 2013-02-06 11:00:38 +01:00
parent 2ae395d6c2
commit 1aee1fb38d
7 changed files with 188 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
gcc/ada/ChangeLog
View File

@ -1,3 +1,34 @@
2013-02-06 Gary Dismukes <dismukes@adacore.com>
* sem_ch6.adb (Check_For_Primitive_Subprogram): Test for
the special case of a user-defined equality that overrides
the predefined equality of a nonderived type declared in a
declarative part.
* sem_util.adb (Collect_Primitive_Operations): Add test for
Is_Primitive when looping over the subprograms following a type,
to catch the case of primitives such as a user-defined equality,
which otherwise won't be found when the type is not a derived
type and is declared in a declarative part.
2013-02-06 Vincent Celier <celier@adacore.com>
* prj-conf.adb (Check_Target): Always return True when Target
is empty (Get_Or_Create_Configuration_File.Get_Project_Target):
New procedure to get the value of attribute Target in the main
project.
(Get_Or_Create_Configuration_File.Do_Autoconf): No
need to get the value of attribute Target in the main project.
(Get_Or_Create_Configuration_File): Call Get_Project_Target and
use the target fom this call.
2013-02-06 Eric Botcazou <ebotcazou@adacore.com>
* erroutc.adb (Validate_Specific_Warning): Do not issue the
warning about an ineffective Pragma Warnings for -Wxxx warnings.
* sem_prag.adb (Analyze_Pragma) <Warnings>: Accept -Wxxx warnings.
* gnat_rm.texi (Pragma Warnings): Document coordination with
warnings of the GCC back-end.
2013-02-06 Javier Miranda <miranda@adacore.com>
* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Do not build the body

11
gcc/ada/erroutc.adb
View File

@ -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- --
@ -1282,7 +1282,14 @@ package body Erroutc is
Eproc.all
("?pragma Warnings Off with no matching Warnings On",
SWE.Start);
elsif not SWE.Used then
-- Do not issue this warning for -Wxxx messages since the
-- back-end doesn't report the information.
elsif not SWE.Used
and then not (SWE.Msg'Length > 2
and then SWE.Msg (1 .. 2) = "-W")
then
Eproc.all
("?no warning suppressed by this pragma", SWE.Start);
end if;

14
gcc/ada/gnat_rm.texi
View File

@ -6153,6 +6153,14 @@ the list of warnings switches supported. For
full details see @ref{Warning Message Control,,, gnat_ugn, @value{EDITION}
User's Guide}.
@noindent
The warnings controlled by the `-gnatw' switch are generated by the front end
of the compiler. The `GCC' back end can provide additional warnings and they
are controlled by the `-W' switch.
The form with a single static_string_EXPRESSION argument also works for the
latters, but the string must be a single full `-W' switch in this case.
The above reference lists a few examples of these additional warnings.
@noindent
The specified warnings will be in effect until the end of the program
or another pragma Warnings is encountered. The effect of the pragma is
@ -6173,6 +6181,12 @@ message @code{warning: 960 bits of "a" unused}. No other regular
expression notations are permitted. All characters other than asterisk in
these three specific cases are treated as literal characters in the match.
@noindent
The fourth form also works for the additional warnings of the `GCC' back end,
but the string must again be a single full `-W' switch in this case. Note that
the message issued for these warnings explicitly lists the full `-W' switch
they are associated with.
There are two ways to use the pragma in this form. The OFF form can be used as a
configuration pragma. The effect is to suppress all warnings (if any)
that match the pattern string throughout the compilation.

121
gcc/ada/prj-conf.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2006-2012, Free Software Foundation, Inc. --
-- Copyright (C) 2006-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- --
@ -565,12 +565,11 @@ package body Prj.Conf is
Tgt_Name := Variable.Value;
end if;
if Target = "" then
OK := Autoconf_Specified or else Tgt_Name = No_Name;
else
OK := Tgt_Name /= No_Name
and then Target = Get_Name_String (Tgt_Name);
end if;
OK :=
Target = ""
or else
(Tgt_Name /= No_Name
and then Target = Get_Name_String (Tgt_Name));
if not OK then
if Autoconf_Specified then
@ -625,6 +624,8 @@ package body Prj.Conf is
-- The configuration project file name. May be modified if there are
-- switches --config= in the Builder package of the main project.
Selected_Target : String_Access := new String'(Target_Name);
function Default_File_Name return String;
-- Return the name of the default config file that should be tested
@ -635,6 +636,10 @@ package body Prj.Conf is
procedure Check_Builder_Switches;
-- Check for switches --config and --RTS in package Builder
procedure Get_Project_Target;
-- Target_Name is empty, get the specifiedtarget in the project file,
-- if any.
function Get_Config_Switches return Argument_List_Access;
-- Return the --config switches to use for gprconfig
@ -766,6 +771,47 @@ package body Prj.Conf is
end if;
end Check_Builder_Switches;
------------------------
-- Get_Project_Target --
------------------------
procedure Get_Project_Target is
begin
if Selected_Target'Length = 0 then
-- Check if attribute Target is specified in the main
-- project, or in a project it extends. If it is, use this
-- target to invoke gprconfig.
declare
Variable : Variable_Value;
Proj : Project_Id;
Tgt_Name : Name_Id := No_Name;
begin
Proj := Project;
Project_Loop :
while Proj /= No_Project loop
Variable :=
Value_Of (Name_Target, Proj.Decl.Attributes, Shared);
if Variable /= Nil_Variable_Value
and then not Variable.Default
and then Variable.Value /= No_Name
then
Tgt_Name := Variable.Value;
exit Project_Loop;
end if;
Proj := Proj.Extends;
end loop Project_Loop;
if Tgt_Name /= No_Name then
Selected_Target := new String'(Get_Name_String (Tgt_Name));
end if;
end;
end if;
end Get_Project_Target;
-----------------------
-- Default_File_Name --
-----------------------
@ -775,13 +821,14 @@ package body Prj.Conf is
Tmp : String_Access;
begin
if Target_Name /= "" then
if Selected_Target'Length /= 0 then
if Ada_RTS /= "" then
return
Target_Name & '-' & Ada_RTS & Config_Project_File_Extension;
Selected_Target.all & '-' &
Ada_RTS & Config_Project_File_Extension;
else
return
Target_Name & Config_Project_File_Extension;
Selected_Target.all & Config_Project_File_Extension;
end if;
elsif Ada_RTS /= "" then
@ -972,51 +1019,17 @@ package body Prj.Conf is
if Normalized_Hostname = "" then
Arg_Last := 3;
else
if Target_Name = "" then
if Selected_Target'Length = 0 then
if At_Least_One_Compiler_Command then
Args (4) := new String'("--target=all");
-- Check if attribute Target is specified in the main
-- project, or in a project it extends. If it is, use this
-- target to invoke gprconfig.
declare
Variable : Variable_Value;
Proj : Project_Id;
Tgt_Name : Name_Id := No_Name;
begin
Proj := Project;
Project_Loop :
while Proj /= No_Project loop
Variable :=
Value_Of (Name_Target, Proj.Decl.Attributes, Shared);
if Variable /= Nil_Variable_Value
and then not Variable.Default
and then Variable.Value /= No_Name
then
Tgt_Name := Variable.Value;
exit Project_Loop;
end if;
Proj := Proj.Extends;
end loop Project_Loop;
if Tgt_Name /= No_Name then
Args (4) :=
new String'("--target=" &
Get_Name_String (Tgt_Name));
elsif At_Least_One_Compiler_Command then
Args (4) := new String'("--target=all");
else
Args (4) :=
new String'("--target=" & Normalized_Hostname);
end if;
end;
else
Args (4) :=
new String'("--target=" & Normalized_Hostname);
end if;
else
Args (4) := new String'("--target=" & Target_Name);
Args (4) := new String'("--target=" & Selected_Target.all);
end if;
Arg_Last := 4;
@ -1348,6 +1361,7 @@ package body Prj.Conf is
Free (Config_File_Path);
Config := No_Project;
Get_Project_Target;
Check_Builder_Switches;
if Conf_File_Name'Length > 0 then
@ -1448,7 +1462,8 @@ package body Prj.Conf is
if not Automatically_Generated
and then not
Check_Target (Config, Autoconf_Specified, Project_Tree, Target_Name)
Check_Target
(Config, Autoconf_Specified, Project_Tree, Selected_Target.all)
then
Automatically_Generated := True;
goto Process_Config_File;

24
gcc/ada/sem_ch6.adb
View File

@ -9754,6 +9754,30 @@ package body Sem_Ch6 is
Next_Formal (Formal);
end loop;
-- Special case: An equality function can be redefined for a type
-- occurring in a declarative part, and won't otherwise be treated as
-- a primitive because it doesn't occur in a package spec and doesn't
-- override an inherited subprogram. It's important that we mark it
-- primitive so it can be returned by Collect_Primitive_Operations
-- and be used in composing the equality operation of later types
-- that have a component of the type.
elsif Chars (S) = Name_Op_Eq
and then Etype (S) = Standard_Boolean
then
B_Typ := Base_Type (Etype (First_Formal (S)));
if Scope (B_Typ) = Current_Scope
and then
Base_Type (Etype (Next_Formal (First_Formal (S)))) = B_Typ
and then not Is_Limited_Type (B_Typ)
then
Is_Primitive := True;
Set_Is_Primitive (S);
Set_Has_Primitive_Operations (B_Typ);
Check_Private_Overriding (B_Typ);
end if;
end if;
end Check_For_Primitive_Subprogram;

16
gcc/ada/sem_prag.adb
View File

@ -16017,9 +16017,23 @@ package body Sem_Prag is
if OK then
Chr := Get_Character (C);
-- Dash case: only -Wxxx is accepted
if J = 1
and then J < Len
and then Chr = '-'
then
J := J + 1;
C := Get_String_Char (Str, J);
Chr := Get_Character (C);
if Chr = 'W' then
exit;
end if;
OK := False;
-- Dot case
if J < Len and then Chr = '.' then
elsif J < Len and then Chr = '.' then
J := J + 1;
C := Get_String_Char (Str, J);
Chr := Get_Character (C);

39
gcc/ada/sem_util.adb
View File

@ -2577,6 +2577,7 @@ package body Sem_Util is
Op_List : Elist_Id;
Formal : Entity_Id;
Is_Prim : Boolean;
Is_Type_In_Pkg : Boolean;
Formal_Derived : Boolean := False;
Id : Entity_Id;
@ -2636,12 +2637,9 @@ package body Sem_Util is
null;
end if;
elsif (Is_Package_Or_Generic_Package (B_Scope)
and then
Nkind (Parent (Declaration_Node (First_Subtype (T)))) /=
N_Package_Body)
or else Is_Derived_Type (B_Type)
then
-- Locate the primitive subprograms of the type
else
-- The primitive operations appear after the base type, except
-- if the derivation happens within the private part of B_Scope
-- and the type is a private type, in which case both the type
@ -2657,13 +2655,30 @@ package body Sem_Util is
Id := Next_Entity (B_Type);
end if;
-- Set flag if this is a type in a package spec
Is_Type_In_Pkg :=
Is_Package_Or_Generic_Package (B_Scope)
and then
Nkind (Parent (Declaration_Node (First_Subtype (T)))) /=
N_Package_Body;
while Present (Id) loop
-- Note that generic formal subprograms are not
-- considered to be primitive operations and thus
-- are never inherited.
-- Test whether the result type or any of the parameter types of
-- each subprogram following the type match that type when the
-- type is declared in a package spec, is a derived type, or the
-- subprogram is marked as primitive. (The Is_Primitive test is
-- needed to find primitives of nonderived types in declarative
-- parts that happen to override the predefined "=" operator.)
-- Note that generic formal subprograms are not considered to be
-- primitive operations and thus are never inherited.
if Is_Overloadable (Id)
and then (Is_Type_In_Pkg
or else Is_Derived_Type (B_Type)
or else Is_Primitive (Id))
and then Nkind (Parent (Parent (Id)))
not in N_Formal_Subprogram_Declaration
then
@ -2684,9 +2699,9 @@ package body Sem_Util is
end loop;
end if;
-- For a formal derived type, the only primitives are the
-- ones inherited from the parent type. Operations appearing
-- in the package declaration are not primitive for it.
-- For a formal derived type, the only primitives are the ones
-- inherited from the parent type. Operations appearing in the
-- package declaration are not primitive for it.
if Is_Prim
and then (not Formal_Derived