diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 24 | ||||
| -rw-r--r-- | gcc/ada/checks.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/exp_ch3.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/gnatcmd.adb | 34 | ||||
| -rw-r--r-- | gcc/ada/make.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/sem_warn.adb | 57 |
6 files changed, 106 insertions, 51 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2b7841c..6feb58d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,29 @@ 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 stderr, not stdout. diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 685016f..2861d7c 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -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))); diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 066b37d..b43dfd8 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -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)); diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 82e3f45..ef93f2f 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -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); diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 957e35d..2d53ee2 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -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; diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index c05cf3b..34bc458 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -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. + + 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)) @@ -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 |