+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
-- 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;
-- 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
-- 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;
-- 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)
procedure Apply_Predicate_Check (N : Node_Id; Typ : Entity_Id) is
S : Entity_Id;
+
begin
if Present (Predicate_Function (Typ)) then
-- 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)));
-- 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));
-- -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);
-- -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;
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.
+
+ if Function_Call_Found then
+ declare
+ P : Node_Id;
- 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!
-
- if No (P) or else Nkind (P) = N_Procedure_Call_Statement then
- return Abandon;
- end if;
- end loop;
- end;
+ -- 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;
+ 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))
then
return Abandon;
- -- Call to subprogram
+ -- Call to subprogram
elsif Nkind (N) in N_Subprogram_Call then
projects / thirdparty / gcc.git / commitdiff
