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 e8eaa7556b7cda0fe2f030e9db5673134ab0192d..f3db82c3e72432628f3c34d4b4ab7d574e55f7aa 100644 (file)
--- 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 d84e8aeb29f36ae30d782c74f73c3eb32e3677ef..3de75356d4e6f0431fb554f764861e8be38f9605 100644 (file)
--- 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 ca9dbf9f8411c9b52c21fe0c33aa6e1fb99a5431..0b31c9e15d6302ecdbf627245b0ef68a47957125 100644 (file)
--- 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;