[gcc r13-394] [Ada] Crash in task body reference to discriminant

[gcc r13-394] [Ada] Crash in task body reference to discriminant

[Pierre-Marie de Rodat]

https://gcc.gnu.org/g:fafccfbf77ac245c7fa77c06e4ae001009c3425e

commit r13-394-gfafccfbf77ac245c7fa77c06e4ae001009c3425e
Author: Javier Miranda <miranda@adacore.com>
Date:   Sun Feb 6 11:23:53 2022 +0000

    [Ada] Crash in task body reference to discriminant
    
    The compiler may crash processing the successor or predecessor of a task
    type discrete discriminant.
    
    gcc/ada/
    
            * sem_attr.adb (Resolve_Attribute): Ensure that attribute
            expressions are resolved at this stage; required for preanalyzed
            references to discriminants since their resolution (and
            expansion) will take care of updating their Entity attribute to
            reference their discriminal.

Diff:
---
 gcc/ada/sem_attr.adb | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 47485676c74..55da9ef73f2 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -12500,6 +12500,28 @@ package body Sem_Attr is
                when others => null;
             end case;
 
+            --  Ensure that attribute expressions are resolved at this stage;
+            --  required for preanalyzed references to discriminants since
+            --  their resolution (and expansion) will take care of updating
+            --  their Entity attribute to reference their discriminal.
+
+            if Expander_Active
+              and then Present (Expressions (N))
+            then
+               declare
+                  Expr : Node_Id := First (Expressions (N));
+
+               begin
+                  while Present (Expr) loop
+                     if not Analyzed (Expr) then
+                        Resolve (Expr, Etype (Expr));
+                     end if;
+
+                     Next (Expr);
+                  end loop;
+               end;
+            end if;
+
             --  If the prefix of the attribute is a class-wide type then it
             --  will be expanded into a dispatching call to a predefined
             --  primitive. Therefore we must check for potential violation