From: Mathias Aparicio <[email protected]>
Before this patch, Case_Expression inside a Pragma_Predicate with a
non-static alternative (like a function call) led the Case_Expression
Node to survive unexpanded and caused gnat_to_gnu to abort
(gcc_unreachable for N_Case_Expression).
The guard in Expand_N_Case_Expression checking for non-static
Predicate_Aspect used Has_Dynamic_Predicate_Aspect, which was false
even with a function call in a Case_Expression alternative.
Now add Is_Predicate_Static to the check, which fixes the bug.
This function was private to the sem_ch13 package, so it was made public.
gcc/ada/ChangeLog:
* sem_ch13.ads (Is_Predicate_Static): Public declaration,
from the private function in the package body
* sem_ch13.adb (Is_Predicate_Static): Remove the now-redundant
local declaration
* exp_ch4.adb (Expand_N_Case_Expression): Add Is_Predicate_Static
to the static guard
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch4.adb | 4 +++-
gcc/ada/sem_ch13.adb | 35 -----------------------------------
gcc/ada/sem_ch13.ads | 33 +++++++++++++++++++++++++++++++++
3 files changed, 36 insertions(+), 36 deletions(-)
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index e8eaa7556b7..f3db82c3e72 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -5291,7 +5291,7 @@ package body Exp_Ch4 is
-- If the case expression is a predicate specification, do not expand
-- because it will need to be recognized and converted to the canonical
- -- predicate form later if it it happens to be static.
+ -- predicate form later if it happens to be static.
if Ekind (Scop) in E_Function | E_Procedure
and then Is_Predicate_Function (Scop)
@@ -5299,6 +5299,8 @@ package body Exp_Ch4 is
and then Entity (Expression (N)) = First_Entity (Scop)
and then (Is_Scalar_Type (Etype (Expression (N)))
or else Is_String_Type (Etype (Expression (N))))
+ and then Is_Predicate_Static
+ (Expr => N, Nam => Chars (First_Entity (Scop)), Warn => False)
and then not Has_Dynamic_Predicate_Aspect (Etype (Expression (N)))
then
return;
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index d84e8aeb29f..3de75356d4e 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -45,7 +45,6 @@ with Ghost; use Ghost;
with Lib; use Lib;
with Lib.Xref; use Lib.Xref;
with Mutably_Tagged; use Mutably_Tagged;
-with Namet; use Namet;
with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
@@ -235,40 +234,6 @@ package body Sem_Ch13 is
-- Returns True for a representation clause/pragma that specifies a
-- type-related representation (as opposed to operational) aspect.
- function Is_Predicate_Static
- (Expr : Node_Id;
- Nam : Name_Id;
- Warn : Boolean := True) return Boolean;
- -- Given predicate expression Expr, tests if Expr is predicate-static in
- -- the sense of the rules in (RM 3.2.4 (15-24)). Occurrences of the type
- -- name in the predicate expression have been replaced by references to
- -- an identifier whose Chars field is Nam. This name is unique, so any
- -- identifier with Chars matching Nam must be a reference to the type.
- -- Returns True if the expression is predicate-static and False otherwise,
- -- but is not in the business of setting flags or issuing error messages.
- --
- -- Only scalar types can have static predicates, so False is always
- -- returned for non-scalar types.
- --
- -- Note: the RM seems to suggest that string types can also have static
- -- predicates. But that really makes little sense as very few useful
- -- predicates can be constructed for strings. Remember that:
- --
- -- "ABC" < "DEF"
- --
- -- is not a static expression. So even though the clearly faulty RM wording
- -- allows the following:
- --
- -- subtype S is String with Static_Predicate => S < "DEF"
- --
- -- We can't allow this, otherwise we have predicate-static applying to a
- -- larger class than static expressions, which was never intended.
- --
- -- The Warn parameter is True iff this is not a recursive call. This
- -- parameter is used to avoid generating warnings for subexpressions and
- -- for cases where the predicate expression (as originally written by
- -- the user, before any transformations) is a Boolean literal.
-
procedure New_Put_Image_Subprogram
(N : Node_Id;
Ent : Entity_Id;
diff --git a/gcc/ada/sem_ch13.ads b/gcc/ada/sem_ch13.ads
index ca9dbf9f841..0b31c9e15d6 100644
--- a/gcc/ada/sem_ch13.ads
+++ b/gcc/ada/sem_ch13.ads
@@ -28,6 +28,7 @@ with Types; use Types;
with Sem_Disp; use Sem_Disp;
with Sinfo.Nodes; use Sinfo.Nodes;
with Uintp; use Uintp;
+with Namet; use Namet;
package Sem_Ch13 is
function All_Membership_Choices_Static (Expr : Node_Id) return Boolean;
@@ -386,4 +387,36 @@ package Sem_Ch13 is
procedure Uninstall_Discriminants (E : Entity_Id);
-- Remove visibility to the discriminants of type entity E
+ function Is_Predicate_Static
+ (Expr : Node_Id; Nam : Name_Id; Warn : Boolean := True) return Boolean;
+ -- Given predicate expression Expr, tests if Expr is predicate-static in
+ -- the sense of the rules in (RM 3.2.4 (15-24)). Occurrences of the type
+ -- name in the predicate expression have been replaced by references to
+ -- an identifier whose Chars field is Nam. This name is unique, so any
+ -- identifier with Chars matching Nam must be a reference to the type.
+ -- Returns True if the expression is predicate-static and False otherwise,
+ -- but is not in the business of setting flags or issuing error messages.
+ --
+ -- Only scalar types can have static predicates, so False is always
+ -- returned for non-scalar types.
+ --
+ -- Note: the RM seems to suggest that string types can also have static
+ -- predicates. But that really makes little sense as very few useful
+ -- predicates can be constructed for strings. Remember that:
+ --
+ -- "ABC" < "DEF"
+ --
+ -- is not a static expression. So even though the clearly faulty RM wording
+ -- allows the following:
+ --
+ -- subtype S is String with Static_Predicate => S < "DEF"
+ --
+ -- We can't allow this, otherwise we have predicate-static applying to a
+ -- larger class than static expressions, which was never intended.
+ --
+ -- The Warn parameter is True iff this is not a recursive call. This
+ -- parameter is used to avoid generating warnings for subexpressions and
+ -- for cases where the predicate expression (as originally written by
+ -- the user, before any transformations) is a Boolean literal.
+
end Sem_Ch13;
--
2.53.0
