Merge branch 'topic/1110' into 'master'

Fix CaseExpr xref_equation

Closes #1110

See merge request eng/libadalang/libadalang!1433

ada/ast.py

@@ -16578,7 +16578,8 @@ def xref_equation():
                     Predicate(BaseTypeDecl.is_not_universal_type,
                               alt.expr.type_var)
                     & Bind(alt.expr.type_var, alt.expr.expected_type_var,
-                           conv_prop=BaseTypeDecl.base_subtype),
+                           conv_prop=BaseTypeDecl.base_subtype)
+                    & Bind(alt.expr.expected_type_var, Self.expected_type_var),
                     LogicTrue()
                 ),
                 LogicTrue()

testsuite/tests/name_resolution/case_expr_3/test.adb

@@ -0,0 +1,26 @@
+procedure Test is
+   procedure P is null;
+
+   type Month is (Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec);
+   type Employee is (Jan, Jen, Jim, Tim, Tom, Mary, Randy, Ike);
+
+   Selector : Natural := 1;
+begin
+   case (case Selector is
+            when 0      => Jan,
+            when 1..8   => Oct,
+            when others => Dec) is
+      when Jan    => P;
+      when others => P;
+   end case;
+   pragma Test_Statement;
+
+   case (case Selector is
+            when 0      => Jan,
+            when 1..8   => Jen,
+            when others => Jim) is
+      when Jan    => P;
+      when others => P;
+   end case;
+   pragma Test_Statement;
+end Test;

testsuite/tests/name_resolution/case_expr_3/test.out

@@ -0,0 +1,113 @@
+Analyzing test.adb
+##################
+
+Resolving xrefs for node <CaseStmt test.adb:9:4-15:13>
+******************************************************
+
+Expr: <ParenExpr test.adb:9:9-12:32>
+  type:          <ConcreteTypeDecl ["Month"] test.adb:4:4-4:79>
+  expected type: <ConcreteTypeDecl ["Month"] test.adb:4:4-4:79>
+Expr: <CaseExpr test.adb:9:10-12:31>
+  type:          <ConcreteTypeDecl ["Month"] test.adb:4:4-4:79>
+  expected type: <ConcreteTypeDecl ["Month"] test.adb:4:4-4:79>
+Expr: <Id "Selector" test.adb:9:15-9:23>
+  references:    <DefiningName "Selector" test.adb:7:4-7:12>
+  type:          <SubtypeDecl ["Natural"] __standard:5:3-5:57>
+  expected type: None
+Expr: <CaseExprAlternative test.adb:10:13-10:31>
+  type:          None
+  expected type: None
+Expr: <Int test.adb:10:18-10:19>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: <SubtypeDecl ["Natural"] __standard:5:3-5:57>
+Expr: <Id "Jan" test.adb:10:28-10:31>
+  references:    <DefiningName "Jan" test.adb:4:19-4:22>
+  type:          <ConcreteTypeDecl ["Month"] test.adb:4:4-4:79>
+  expected type: <ConcreteTypeDecl ["Month"] test.adb:4:4-4:79>
+Expr: <CaseExprAlternative test.adb:11:13-11:31>
+  type:          None
+  expected type: None
+Expr: <BinOp test.adb:11:18-11:22>
+  type:          <SubtypeDecl ["Natural"] __standard:5:3-5:57>
+  expected type: <SubtypeDecl ["Natural"] __standard:5:3-5:57>
+Expr: <Int test.adb:11:18-11:19>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: <SubtypeDecl ["Natural"] __standard:5:3-5:57>
+Expr: <OpDoubleDot ".." test.adb:11:19-11:21>
+  references:    None
+  type:          None
+  expected type: None
+Expr: <Int test.adb:11:21-11:22>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: <SubtypeDecl ["Natural"] __standard:5:3-5:57>
+Expr: <Id "Oct" test.adb:11:28-11:31>
+  references:    <DefiningName "Oct" test.adb:4:64-4:67>
+  type:          <ConcreteTypeDecl ["Month"] test.adb:4:4-4:79>
+  expected type: <ConcreteTypeDecl ["Month"] test.adb:4:4-4:79>
+Expr: <CaseExprAlternative test.adb:12:13-12:31>
+  type:          None
+  expected type: None
+Expr: <Id "Dec" test.adb:12:28-12:31>
+  references:    <DefiningName "Dec" test.adb:4:74-4:77>
+  type:          <ConcreteTypeDecl ["Month"] test.adb:4:4-4:79>
+  expected type: <ConcreteTypeDecl ["Month"] test.adb:4:4-4:79>
+
+Resolving xrefs for node <CaseStmt test.adb:18:4-24:13>
+*******************************************************
+
+Expr: <ParenExpr test.adb:18:9-21:32>
+  type:          <ConcreteTypeDecl ["Employee"] test.adb:5:4-5:65>
+  expected type: <ConcreteTypeDecl ["Employee"] test.adb:5:4-5:65>
+Expr: <CaseExpr test.adb:18:10-21:31>
+  type:          <ConcreteTypeDecl ["Employee"] test.adb:5:4-5:65>
+  expected type: <ConcreteTypeDecl ["Employee"] test.adb:5:4-5:65>
+Expr: <Id "Selector" test.adb:18:15-18:23>
+  references:    <DefiningName "Selector" test.adb:7:4-7:12>
+  type:          <SubtypeDecl ["Natural"] __standard:5:3-5:57>
+  expected type: None
+Expr: <CaseExprAlternative test.adb:19:13-19:31>
+  type:          None
+  expected type: None
+Expr: <Int test.adb:19:18-19:19>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: <SubtypeDecl ["Natural"] __standard:5:3-5:57>
+Expr: <Id "Jan" test.adb:19:28-19:31>
+  references:    <DefiningName "Jan" test.adb:5:22-5:25>
+  type:          <ConcreteTypeDecl ["Employee"] test.adb:5:4-5:65>
+  expected type: <ConcreteTypeDecl ["Employee"] test.adb:5:4-5:65>
+Expr: <CaseExprAlternative test.adb:20:13-20:31>
+  type:          None
+  expected type: None
+Expr: <BinOp test.adb:20:18-20:22>
+  type:          <SubtypeDecl ["Natural"] __standard:5:3-5:57>
+  expected type: <SubtypeDecl ["Natural"] __standard:5:3-5:57>
+Expr: <Int test.adb:20:18-20:19>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: <SubtypeDecl ["Natural"] __standard:5:3-5:57>
+Expr: <OpDoubleDot ".." test.adb:20:19-20:21>
+  references:    None
+  type:          None
+  expected type: None
+Expr: <Int test.adb:20:21-20:22>
+  references:    None
+  type:          <ConcreteTypeDecl ["Universal_Int_Type_"] __standard:116:3-116:45>
+  expected type: <SubtypeDecl ["Natural"] __standard:5:3-5:57>
+Expr: <Id "Jen" test.adb:20:28-20:31>
+  references:    <DefiningName "Jen" test.adb:5:27-5:30>
+  type:          <ConcreteTypeDecl ["Employee"] test.adb:5:4-5:65>
+  expected type: <ConcreteTypeDecl ["Employee"] test.adb:5:4-5:65>
+Expr: <CaseExprAlternative test.adb:21:13-21:31>
+  type:          None
+  expected type: None
+Expr: <Id "Jim" test.adb:21:28-21:31>
+  references:    <DefiningName "Jim" test.adb:5:32-5:35>
+  type:          <ConcreteTypeDecl ["Employee"] test.adb:5:4-5:65>
+  expected type: <ConcreteTypeDecl ["Employee"] test.adb:5:4-5:65>
+
+
+Done.

testsuite/tests/name_resolution/case_expr_3/test.yaml

@@ -0,0 +1,2 @@
+driver: name-resolution
+input_sources: [test.adb]