diff options
| author | Justin Squirek <squirek@adacore.com> | 2019-07-11 08:01:30 +0000 |
|---|---|---|
| committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2019-07-11 08:01:30 +0000 |
| commit | ccf173059688499749a30b3252cc3c4ea4ab0d0c (patch) | |
| tree | 9f6cb8f06328b7298cccd7e69f9360f70b98d372 /gcc/ada | |
| parent | a1a8b1726cf8de2ed244353a9c8cd2fab12e4c71 (diff) | |
| download | gcc-ccf173059688499749a30b3252cc3c4ea4ab0d0c.zip gcc-ccf173059688499749a30b3252cc3c4ea4ab0d0c.tar.gz gcc-ccf173059688499749a30b3252cc3c4ea4ab0d0c.tar.bz2 | |
[Ada] No warning for guaranteed accessibility check failures
This patch corrects the generation of dynamic accessibility checks which
are guaranteed to trigger errors during run time so as to give the user
proper warning during unit compiliation.
2019-07-11 Justin Squirek <squirek@adacore.com>
gcc/ada/
* checks.adb (Apply_Accessibility_Check): Add check for constant
folded conditions on accessibility checks.
gcc/testsuite/
* gnat.dg/access7.adb: New testcase.
From-SVN: r273381
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/ada/checks.adb | 25 |
2 files changed, 25 insertions, 5 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 703280c..9104658 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-07-11 Justin Squirek <squirek@adacore.com> + + * checks.adb (Apply_Accessibility_Check): Add check for constant + folded conditions on accessibility checks. + 2019-07-11 Arnaud Charlet <charlet@adacore.com> * libgnarl/g-thread.ads, libgnarl/g-thread.adb (Get_Thread): diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 601b932..7ca66bd 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -577,6 +577,7 @@ package body Checks is Typ : Entity_Id; Insert_Node : Node_Id) is + Check_Cond : Node_Id; Loc : constant Source_Ptr := Sloc (N); Param_Ent : Entity_Id := Param_Entity (N); Param_Level : Node_Id; @@ -638,15 +639,29 @@ package body Checks is -- Raise Program_Error if the accessibility level of the access -- parameter is deeper than the level of the target access type. + Check_Cond := Make_Op_Gt (Loc, + Left_Opnd => Param_Level, + Right_Opnd => Type_Level); + Insert_Action (Insert_Node, Make_Raise_Program_Error (Loc, - Condition => - Make_Op_Gt (Loc, - Left_Opnd => Param_Level, - Right_Opnd => Type_Level), - Reason => PE_Accessibility_Check_Failed)); + Condition => Check_Cond, + Reason => PE_Accessibility_Check_Failed)); Analyze_And_Resolve (N); + + -- If constant folding has happened on the condition for the + -- generated error, then warn about it being unconditional. + + if Nkind (Check_Cond) = N_Identifier + and then Entity (Check_Cond) = Standard_True + then + Error_Msg_Warn := SPARK_Mode /= On; + Error_Msg_N + ("accessibility check fails<<", N); + Error_Msg_N + ("\Program_Error [<<", N); + end if; end if; end Apply_Accessibility_Check; |