mirror of git://gcc.gnu.org/git/gcc.git
[multiple changes]
2012-10-01 Thomas Quinot <quinot@adacore.com> * gnatcmd.adb, make.adb (Scan_Make_Arg, Inspect_Switches): Recognize and reject an invalid parameter passed to -vP. 2012-10-01 Yannick Moy <moy@adacore.com> * sem_warn.adb (Check_Infinite_Loop_Warning/Test_Ref): Improve the detection of modifications to the loop variable by noting that, if the type of variable is elementary and the condition does not contain a function call, then the condition cannot be modified by side-effects from a procedure call. 2012-10-01 Robert Dewar <dewar@adacore.com> * checks.adb: Add comments. 2012-10-01 Javier Miranda <miranda@adacore.com> * exp_ch3.adb (Expand_N_Object_Declaration): Improve condition catching never-ending recursion. The previous condition erroneously disabled silently the expansion of the class-wide interface object initialization in cases not involving the recursion. From-SVN: r191892
This commit is contained in:
Arnaud Charlet
parent
7246b89096
commit
8e983d807e
|
|
@ -1,3 +1,27 @@
|
|||
2012-10-01 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* gnatcmd.adb, make.adb (Scan_Make_Arg, Inspect_Switches): Recognize
|
||||
and reject an invalid parameter passed to -vP.
|
||||
|
||||
2012-10-01 Yannick Moy <moy@adacore.com>
|
||||
|
||||
* sem_warn.adb (Check_Infinite_Loop_Warning/Test_Ref): Improve
|
||||
the detection of modifications to the loop variable by noting
|
||||
that, if the type of variable is elementary and the condition
|
||||
does not contain a function call, then the condition cannot be
|
||||
modified by side-effects from a procedure call.
|
||||
|
||||
2012-10-01 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* checks.adb: Add comments.
|
||||
|
||||
2012-10-01 Javier Miranda <miranda@adacore.com>
|
||||
|
||||
* exp_ch3.adb (Expand_N_Object_Declaration): Improve condition catching
|
||||
never-ending recursion. The previous condition erroneously disabled
|
||||
silently the expansion of the class-wide interface object
|
||||
initialization in cases not involving the recursion.
|
||||
|
||||
2012-10-01 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* make.adb: Minor documentation fix: error messages are sent to
|
||||
|
|
|
|||
|
|
@ -1791,6 +1791,8 @@ package body Checks is
|
|||
-- Do not generate the checks in Ada 83, 95 or 05 mode because they
|
||||
-- require an Ada 2012 construct.
|
||||
|
||||
-- Why??? these pragmas and attributes are available in all ada modes
|
||||
|
||||
if Ada_Version_Explicit < Ada_2012 then
|
||||
return;
|
||||
end if;
|
||||
|
|
@ -1932,9 +1934,11 @@ package body Checks is
|
|||
-- Extract the subprogram specification and declaration nodes
|
||||
|
||||
Subp_Spec := Parent (Subp);
|
||||
|
||||
if Nkind (Subp_Spec) = N_Defining_Program_Unit_Name then
|
||||
Subp_Spec := Parent (Subp_Spec);
|
||||
end if;
|
||||
|
||||
Subp_Decl := Parent (Subp_Spec);
|
||||
|
||||
-- Do not generate checks in Ada 83 or 95 because the pragmas involved
|
||||
|
|
@ -1961,6 +1965,9 @@ package body Checks is
|
|||
-- through the its contract and recover the pre and post conditions (if
|
||||
-- available).
|
||||
|
||||
-- So what??? you can have multiple such pragmas, this is unnecessary
|
||||
-- complexity being added for no purpose???
|
||||
|
||||
if Present (Contract (Subp)) then
|
||||
declare
|
||||
Nam : Name_Id;
|
||||
|
|
@ -2080,6 +2087,9 @@ package body Checks is
|
|||
-- Do not process subprograms where pre and post conditions do not make
|
||||
-- sense.
|
||||
|
||||
-- More detail here of why these specific conditions are needed???
|
||||
-- And remember to document them ???
|
||||
|
||||
if not Comes_From_Source (Subp)
|
||||
or else Is_Imported (Subp)
|
||||
or else Is_Intrinsic_Subprogram (Subp)
|
||||
|
|
@ -2127,6 +2137,7 @@ package body Checks is
|
|||
|
||||
procedure Apply_Predicate_Check (N : Node_Id; Typ : Entity_Id) is
|
||||
S : Entity_Id;
|
||||
|
||||
begin
|
||||
if Present (Predicate_Function (Typ)) then
|
||||
|
||||
|
|
@ -2134,17 +2145,12 @@ package body Checks is
|
|||
-- subprograms, such as TSS functions.
|
||||
|
||||
S := Current_Scope;
|
||||
while Present (S)
|
||||
and then not Is_Subprogram (S)
|
||||
loop
|
||||
while Present (S) and then not Is_Subprogram (S) loop
|
||||
S := Scope (S);
|
||||
end loop;
|
||||
|
||||
if Present (S)
|
||||
and then Get_TSS_Name (S) /= TSS_Null
|
||||
then
|
||||
if Present (S) and then Get_TSS_Name (S) /= TSS_Null then
|
||||
return;
|
||||
|
||||
else
|
||||
Insert_Action (N,
|
||||
Make_Predicate_Check (Typ, Duplicate_Subexpr (N)));
|
||||
|
|
|
|||
|
|
@ -4910,8 +4910,15 @@ package body Exp_Ch3 is
|
|||
-- Expr's type, both types share the same dispatch table and there is
|
||||
-- no need to displace the pointer.
|
||||
|
||||
elsif Comes_From_Source (N)
|
||||
and then Is_Interface (Typ)
|
||||
elsif Is_Interface (Typ)
|
||||
|
||||
-- Avoid never-ending recursion because if Equivalent_Type is set
|
||||
-- then we've done it already and must not do it again!
|
||||
|
||||
and then not
|
||||
(Nkind (Object_Definition (N)) = N_Identifier
|
||||
and then
|
||||
Present (Equivalent_Type (Entity (Object_Definition (N)))))
|
||||
then
|
||||
pragma Assert (Is_Class_Wide_Type (Typ));
|
||||
|
||||
|
|
|
|||
|
|
@ -1769,19 +1769,27 @@ begin
|
|||
|
||||
-- -vPx Specify verbosity while parsing project files
|
||||
|
||||
elsif Argv'Length = 4
|
||||
and then Argv (Argv'First + 1 .. Argv'First + 2) = "vP"
|
||||
then
|
||||
case Argv (Argv'Last) is
|
||||
when '0' =>
|
||||
Current_Verbosity := Prj.Default;
|
||||
when '1' =>
|
||||
Current_Verbosity := Prj.Medium;
|
||||
when '2' =>
|
||||
Current_Verbosity := Prj.High;
|
||||
when others =>
|
||||
Fail ("Invalid switch: " & Argv.all);
|
||||
end case;
|
||||
elsif Argv (Argv'First + 1 .. Argv'First + 2) = "vP" then
|
||||
if Argv'Length = 4
|
||||
and then Argv (Argv'Last) in '0' .. '2'
|
||||
then
|
||||
case Argv (Argv'Last) is
|
||||
when '0' =>
|
||||
Current_Verbosity := Prj.Default;
|
||||
when '1' =>
|
||||
Current_Verbosity := Prj.Medium;
|
||||
when '2' =>
|
||||
Current_Verbosity := Prj.High;
|
||||
when others =>
|
||||
|
||||
-- Cannot happen
|
||||
|
||||
raise Program_Error;
|
||||
end case;
|
||||
else
|
||||
Fail ("invalid verbosity level: "
|
||||
& Argv (Argv'First + 3 .. Argv'Last));
|
||||
end if;
|
||||
|
||||
Remove_Switch (Arg_Num);
|
||||
|
||||
|
|
|
|||
|
|
@ -7825,11 +7825,12 @@ package body Make is
|
|||
|
||||
-- -vPx (verbosity of the parsing of the project files)
|
||||
|
||||
elsif Argv'Last = 4
|
||||
and then Argv (2 .. 3) = "vP"
|
||||
and then Argv (4) in '0' .. '2'
|
||||
then
|
||||
if And_Save then
|
||||
elsif Argv (2 .. 3) = "vP" then
|
||||
if Argv'Last /= 4 or else Argv (4) not in '0' .. '2' then
|
||||
Make_Failed
|
||||
("invalid verbosity level " & Argv (4 .. Argv'Last));
|
||||
|
||||
elsif And_Save then
|
||||
case Argv (4) is
|
||||
when '0' =>
|
||||
Current_Verbosity := Prj.Default;
|
||||
|
|
|
|||
|
|
@ -472,32 +472,41 @@ package body Sem_Warn is
|
|||
return Abandon;
|
||||
end if;
|
||||
|
||||
-- If we appear in the context of a procedure call, then also
|
||||
-- abandon, since there may be issues of non-visible side
|
||||
-- effects going on in the call.
|
||||
-- If the condition contains a function call, we consider it may
|
||||
-- be modified by side-effects from a procedure call. Otherwise,
|
||||
-- we consider the condition may not be modified, although that
|
||||
-- might happen if Variable is itself a by-reference parameter,
|
||||
-- and the procedure called modifies the global object referred to
|
||||
-- by Variable, but we actually prefer to issue a warning in this
|
||||
-- odd case. Note that the case where the procedure called has
|
||||
-- visibility over Variable is treated in another case below.
|
||||
|
||||
declare
|
||||
P : Node_Id;
|
||||
if Function_Call_Found then
|
||||
declare
|
||||
P : Node_Id;
|
||||
|
||||
begin
|
||||
P := N;
|
||||
loop
|
||||
P := Parent (P);
|
||||
exit when P = Loop_Statement;
|
||||
begin
|
||||
P := N;
|
||||
loop
|
||||
P := Parent (P);
|
||||
exit when P = Loop_Statement;
|
||||
|
||||
-- Abandon if at procedure call, or something strange is
|
||||
-- going on (perhaps a node with no parent that should
|
||||
-- have one but does not?) As always, for a warning we
|
||||
-- prefer to just abandon the warning than get into the
|
||||
-- business of complaining about the tree structure here!
|
||||
-- Abandon if at procedure call, or something strange is
|
||||
-- going on (perhaps a node with no parent that should
|
||||
-- have one but does not?) As always, for a warning we
|
||||
-- prefer to just abandon the warning than get into the
|
||||
-- business of complaining about the tree structure here!
|
||||
|
||||
if No (P) or else Nkind (P) = N_Procedure_Call_Statement then
|
||||
return Abandon;
|
||||
end if;
|
||||
end loop;
|
||||
end;
|
||||
if No (P)
|
||||
or else Nkind (P) = N_Procedure_Call_Statement
|
||||
then
|
||||
return Abandon;
|
||||
end if;
|
||||
end loop;
|
||||
end;
|
||||
end if;
|
||||
|
||||
-- Reference to variable renaming variable in question
|
||||
-- Reference to variable renaming variable in question
|
||||
|
||||
elsif Is_Entity_Name (N)
|
||||
and then Present (Entity (N))
|
||||
|
|
@ -509,7 +518,7 @@ package body Sem_Warn is
|
|||
then
|
||||
return Abandon;
|
||||
|
||||
-- Call to subprogram
|
||||
-- Call to subprogram
|
||||
|
||||
elsif Nkind (N) in N_Subprogram_Call then
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue