From: Mathias Aparicio Date: Mon, 27 Apr 2026 08:53:07 +0000 (+0200) Subject: ada: Fix ICE on Case_Expression a Pragma_Predicate X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=971ad0877a1b10d5fccfeeec1aedcfd2b1ca0d8c;p=thirdparty%2Fgcc.git ada: Fix ICE on Case_Expression a Pragma_Predicate 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 --- 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;