Commit 327b1ba4 by Arnaud Charlet

2013-04-24 Sergey Rybin <rybin@adacore.com frybin>

	* gnat_ugn.texi: Add description of '--help' and '--version'
	options for ASIS tools: gnatelim, gnatmetric, gnatstub, gnatpp.

2013-04-24  Arnaud Charlet  <charlet@adacore.com>

	* gnat_rm.texi: Minor syntax fix.

2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_attr.adb (Expand_Loop_Entry_Attribute): Add extra comments on
	what and why is being analyzed. Remove the decoration of renamings as
	this simply falls out of the general analysis mechanism.

2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_res.adb (Explain_Redundancy): New routine.
	(Resolve_Equality_Op): Place the error concerning a redundant
	comparison to True at the "=". Try to explain the nature of the
	redundant True.

2013-04-24  Javier Miranda  <miranda@adacore.com>


	* checks.adb, exp_ch6.adb (Install_Null_Excluding_Check): No
	check in interface thunks since it is performed at the caller
	side.
	(Expand_Simple_Function_Return): No accessibility check
	needed in thunks since the check is done by the target routine.

2013-04-24  Vincent Celier  <celier@adacore.com>

	* xref_lib.adb (Add_Entity): Use the canonical file names
	so that source file names with capital letters are found on
	platforms where file names are case insensitive.

2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>

	* par-ch4.adb (P_Name): Continue to parse the name extension when the
	construct is attribute Loop_Entry. Do not convert the attribute
	reference into an indexed component when there is at least one
	expression / range following 'Loop_Entry.

2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch6.adb (Contains_Enabled_Pragmas): New routine.
	(Process_PPCs): Generate procedure _Postconditions
	only when the context has invariants or predicates or enabled
	aspects/pragmas.

From-SVN: r198236
parent d436b30d
2013-04-24 Sergey Rybin <rybin@adacore.com frybin>
* gnat_ugn.texi: Add description of '--help' and '--version'
options for ASIS tools: gnatelim, gnatmetric, gnatstub, gnatpp.
2013-04-24 Arnaud Charlet <charlet@adacore.com>
* gnat_rm.texi: Minor syntax fix.
2013-04-24 Hristian Kirtchev <kirtchev@adacore.com>
* exp_attr.adb (Expand_Loop_Entry_Attribute): Add extra comments on
what and why is being analyzed. Remove the decoration of renamings as
this simply falls out of the general analysis mechanism.
2013-04-24 Hristian Kirtchev <kirtchev@adacore.com>
* sem_res.adb (Explain_Redundancy): New routine.
(Resolve_Equality_Op): Place the error concerning a redundant
comparison to True at the "=". Try to explain the nature of the
redundant True.
2013-04-24 Javier Miranda <miranda@adacore.com>
* checks.adb, exp_ch6.adb (Install_Null_Excluding_Check): No
check in interface thunks since it is performed at the caller
side.
(Expand_Simple_Function_Return): No accessibility check
needed in thunks since the check is done by the target routine.
2013-04-24 Vincent Celier <celier@adacore.com>
* xref_lib.adb (Add_Entity): Use the canonical file names
so that source file names with capital letters are found on
platforms where file names are case insensitive.
2013-04-24 Hristian Kirtchev <kirtchev@adacore.com>
* par-ch4.adb (P_Name): Continue to parse the name extension when the
construct is attribute Loop_Entry. Do not convert the attribute
reference into an indexed component when there is at least one
expression / range following 'Loop_Entry.
2013-04-24 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch6.adb (Contains_Enabled_Pragmas): New routine.
(Process_PPCs): Generate procedure _Postconditions
only when the context has invariants or predicates or enabled
aspects/pragmas.
2013-04-24 Thomas Quinot <quinot@adacore.com>
* g-socket.adb (Host_Entry): Introduce intermediate copy of
......
......@@ -985,37 +985,32 @@ package body Exp_Attr is
Rewrite (Attr, New_Reference_To (Temp_Id, Loc));
-- The analysis of the conditional block takes care of the constant
-- declaration.
Installed := Current_Scope = Loop_Id;
-- Depending on the pracement of attribute 'Loop_Entry relative to the
-- associated loop, ensure the proper visibility for analysis.
if not Installed then
Push_Scope (Scope (Loop_Id));
end if;
-- The analysis of the conditional block takes care of the constant
-- declaration.
if Present (Result) then
Rewrite (Loop_Stmt, Result);
Analyze (Loop_Stmt);
-- The conditional block was analyzed when a previous 'Loop_Entry was
-- expanded. There is no point in reanalyzing the block, simply analyze
-- the declaration of the constant.
else
Analyze (Temp_Decl);
end if;
Analyze (Attr);
-- Patch up a renaming of a 'Loop_Entry attribute. This case may arise
-- when the attribute is used as the name in an Ada 2012 iterator loop.
if Nkind (Parent (Attr)) = N_Object_Renaming_Declaration then
declare
Mark : constant Node_Id := Subtype_Mark (Parent (Attr));
begin
Rewrite (Mark, New_Reference_To (Etype (Temp_Id), Sloc (Mark)));
Analyze (Mark);
end;
end if;
if not Installed then
Pop_Scope;
end if;
......
......@@ -5135,9 +5135,9 @@ compiles with the Rational APEX compiler, even when the code includes non-
conforming Ada constructs. The profile enables the following three pragmas:
@itemize @bullet
pragma Implicit_Packing;
pragma Overriding_Renamings;
pragma Use_VADS_Size;
@item pragma Implicit_Packing
@item pragma Overriding_Renamings
@item pragma Use_VADS_Size
@end itemize
@noindent
......
......@@ -10910,6 +10910,14 @@ Ada 2005 mode etc.
@table @option
@c !sort!
@item --version
@cindex @option{--version} @command{gnatelim}
Display Copyright and version, then exit disregarding all other options.
@item --help
@cindex @option{--help} @command{gnatelim}
Display usage, then exit disregarding all other options.
@item ^-files^/FILES^=@var{filename}
@cindex @option{^-files^/FILES^} (@code{gnatelim})
Take the argument source files from the specified file. This file should be an
......@@ -14207,6 +14215,14 @@ with @option{^-pipe^/STANDARD_OUTPUT^} option.
The additional @command{gnatpp} switches are defined in this subsection.
@table @option
@item --version
@cindex @option{--version} @command{gnatpp}
Display Copyright and version, then exit disregarding all other options.
@item --help
@cindex @option{--help} @command{gnatpp}
Display usage, then exit disregarding all other options.
@item ^-files @var{filename}^/FILES=@var{filename}^
@cindex @option{^-files^/FILES^} (@code{gnatpp})
Take the argument source files from the specified file. This file should be an
......@@ -15657,6 +15673,14 @@ Report control fan-in coupling
Additional @command{gnatmetric} switches are as follows:
@table @option
@item --version
@cindex @option{--version} @command{gnatmetric}
Display Copyright and version, then exit disregarding all other options.
@item --help
@cindex @option{--help} @command{gnatmetric}
Display usage, then exit disregarding all other options.
@item ^-files @var{filename}^/FILES=@var{filename}^
@cindex @option{^-files^/FILES^} (@code{gnatmetric})
Take the argument source files from the specified file. This file should be an
......@@ -18476,6 +18500,14 @@ is an optional sequence of switches as described in the next section
@table @option
@c !sort!
@item --version
@cindex @option{--version} @command{gnatstub}
Display Copyright and version, then exit disregarding all other options.
@item --help
@cindex @option{--help} @command{gnatstub}
Display usage, then exit disregarding all other options.
@item ^-f^/FULL^
@cindex @option{^-f^/FULL^} (@command{gnatstub})
If the destination directory already contains a file with the name of the
......@@ -509,16 +509,25 @@ package body Ch4 is
and then not
Is_Parameterless_Attribute (Get_Attribute_Id (Attr_Name))
then
Set_Expressions (Name_Node, New_List);
-- Attribute Loop_Entry has no effect on the name extension
-- parsing logic, as if the attribute never existed in the
-- source. Continue parsing the subsequent expressions or
-- ranges.
if Attr_Name = Name_Loop_Entry then
Scan; -- past left paren
goto Scan_Name_Extension_Left_Paren;
-- Attribute Update contains an array or record association
-- list which provides new values for various components or
-- elements. The list is parsed as an aggregate.
if Attr_Name = Name_Update then
elsif Attr_Name = Name_Update then
Set_Expressions (Name_Node, New_List);
Append (P_Aggregate, Expressions (Name_Node));
else
Set_Expressions (Name_Node, New_List);
Scan; -- past left paren
loop
......@@ -695,10 +704,20 @@ package body Ch4 is
elsif not Comma_Present then
T_Right_Paren;
Prefix_Node := Name_Node;
Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node));
Set_Prefix (Name_Node, Prefix_Node);
Set_Expressions (Name_Node, Arg_List);
-- Do not convert Prefix'Loop_Entry (Expr1, ..., ExprN) into an
-- indexed component now. Let the analysis determine whether the
-- attribute is legal and perform the transformation if needed.
if Attr_Name = Name_Loop_Entry then
Set_Expressions (Name_Node, Arg_List);
else
Prefix_Node := Name_Node;
Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node));
Set_Prefix (Name_Node, Prefix_Node);
Set_Expressions (Name_Node, Arg_List);
end if;
goto Scan_Name_Extension;
end if;
......
......@@ -11196,6 +11196,10 @@ package body Sem_Ch6 is
-- under the same visibility conditions as for other invariant checks,
-- the type invariant must be applied to the returned value.
function Contains_Enabled_Pragmas (L : List_Id) return Boolean;
-- Determine whether list L has at least one enabled pragma. The routine
-- ignores nother non-pragma elements.
procedure Expand_Contract_Cases (CCs : Node_Id; Subp_Id : Entity_Id);
-- Given pragma Contract_Cases CCs, create the circuitry needed to
-- evaluate case guards and trigger consequence expressions. Subp_Id
......@@ -11263,6 +11267,26 @@ package body Sem_Ch6 is
end if;
end Check_Access_Invariants;
------------------------------
-- Contains_Enabled_Pragmas --
------------------------------
function Contains_Enabled_Pragmas (L : List_Id) return Boolean is
Prag : Node_Id;
begin
Prag := First (L);
while Present (Prag) loop
if Nkind (Prag) = N_Pragma and then Is_Ignored (Prag) then
return False;
end if;
Next (Prag);
end loop;
return True;
end Contains_Enabled_Pragmas;
---------------------------
-- Expand_Contract_Cases --
---------------------------
......@@ -12252,8 +12276,11 @@ package body Sem_Ch6 is
-- If we had any postconditions and expansion is enabled, or if the
-- subprogram has invariants, then build the _Postconditions procedure.
if (Present (Plist) or else Invariants_Or_Predicates_Present)
and then Expander_Active
if Expander_Active
and then
(Invariants_Or_Predicates_Present
or else
(Present (Plist) and then Contains_Enabled_Pragmas (Plist)))
then
if No (Plist) then
Plist := Empty_List;
......
......@@ -6821,6 +6821,11 @@ package body Sem_Res is
-- impose an expected type (as can be the case in an equality operation)
-- the expression must be rejected.
procedure Explain_Redundancy (N : Node_Id);
-- Attempt to explain the nature of a redundant comparison with True. If
-- the expression N is too complex, this routine issues a general error
-- message.
function Find_Unique_Access_Type return Entity_Id;
-- In the case of allocators and access attributes, the context must
-- provide an indication of the specific access type to be used. If
......@@ -6850,6 +6855,72 @@ package body Sem_Res is
end if;
end Check_If_Expression;
------------------------
-- Explain_Redundancy --
------------------------
procedure Explain_Redundancy (N : Node_Id) is
Error : Name_Id;
Val : Node_Id;
Val_Id : Entity_Id;
begin
Val := N;
-- Strip the operand down to an entity
loop
if Nkind (Val) = N_Selected_Component then
Val := Selector_Name (Val);
else
exit;
end if;
end loop;
-- The construct denotes an entity
if Is_Entity_Name (Val) and then Present (Entity (Val)) then
Val_Id := Entity (Val);
-- Do not generate an error message when the comparison is done
-- against the enumeration literal Standard.True.
if Ekind (Val_Id) /= E_Enumeration_Literal then
-- Build a customized error message
Name_Len := 0;
Add_Str_To_Name_Buffer ("?r?");
if Ekind (Val_Id) = E_Component then
Add_Str_To_Name_Buffer ("component ");
elsif Ekind (Val_Id) = E_Constant then
Add_Str_To_Name_Buffer ("constant ");
elsif Ekind (Val_Id) = E_Discriminant then
Add_Str_To_Name_Buffer ("discriminant ");
elsif Is_Formal (Val_Id) then
Add_Str_To_Name_Buffer ("parameter ");
elsif Ekind (Val_Id) = E_Variable then
Add_Str_To_Name_Buffer ("variable ");
end if;
Add_Str_To_Name_Buffer ("& is always True!");
Error := Name_Find;
Error_Msg_NE (Get_Name_String (Error), Val, Val_Id);
end if;
-- The construct is too complex to disect, issue a general message
else
Error_Msg_N ("?r?expression is always True!", Val);
end if;
end Explain_Redundancy;
-----------------------------
-- Find_Unique_Access_Type --
-----------------------------
......@@ -6979,12 +7050,13 @@ package body Sem_Res is
if Warn_On_Redundant_Constructs
and then Comes_From_Source (N)
and then Comes_From_Source (R)
and then Is_Entity_Name (R)
and then Entity (R) = Standard_True
and then Comes_From_Source (R)
then
Error_Msg_N -- CODEFIX
("?r?comparison with True is redundant!", R);
("?r?comparison with True is redundant!", N);
Explain_Redundancy (Original_Node (R));
end if;
Check_Unset_Reference (L);
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1998-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- --
......@@ -272,18 +272,21 @@ package body Xref_Lib is
end if;
end if;
File_Ref :=
Add_To_Xref_File
(Entity (File_Start .. Line_Start - 1), Visited => True);
Pattern.File_Ref := File_Ref;
declare
File_Name : String := Entity (File_Start .. Line_Start - 1);
begin
Osint.Canonical_Case_File_Name (File_Name);
File_Ref := Add_To_Xref_File (File_Name, Visited => True);
Pattern.File_Ref := File_Ref;
Add_Line (Pattern.File_Ref, Line_Num, Col_Num);
Add_Line (Pattern.File_Ref, Line_Num, Col_Num);
File_Ref :=
Add_To_Xref_File
(ALI_File_Name (Entity (File_Start .. Line_Start - 1)),
Visited => False,
Emit_Warning => True);
File_Ref :=
Add_To_Xref_File
(ALI_File_Name (File_Name),
Visited => False,
Emit_Warning => True);
end;
end Add_Entity;
-------------------
......
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