From 177b80066ca9f2aecfb0506f227f4e416ecfcca9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Laurent=20Th=C3=A9venoux?= <thevenoux@adacore.com>
Date: Wed, 3 Nov 2021 13:38:53 +0000
Subject: [PATCH] Lkt: emit an error if PropertyError is called without raise

Ensure that PropertyError is called through the raise keyword.

TN: U928-029
---
 contrib/lkt/language/parser.py                |  28 +++++
 .../lkt_semantic/property_error/test.lkt      |  15 ++-
 .../lkt_semantic/property_error/test.out      | 116 +++++++++++++-----
 3 files changed, 122 insertions(+), 37 deletions(-)

diff --git a/contrib/lkt/language/parser.py b/contrib/lkt/language/parser.py
index 90a29baa6..be391358d 100644
--- a/contrib/lkt/language/parser.py
+++ b/contrib/lkt/language/parser.py
@@ -459,6 +459,17 @@ def check_semantic_impl():
             has_error=results.any(lambda r: r.has_error)
         )
 
+    @langkit_property(return_type=T.LKNode.entity)
+    def first_no_paren_parent():
+        """
+        Return the first parent that is not a ``ParenExpr``.
+        """
+        return If(
+            Entity.parent.is_a(ParenExpr),
+            Entity.parent.first_no_paren_parent(),
+            Entity.parent
+        )
+
 
 class LangkitRoot(LKNode):
     """
@@ -2571,6 +2582,23 @@ def check_correctness_pre():
                     )
                 )
             )
+            # In case of PropertyError, check for RaiseExpr
+            ._or(
+                If(
+                    And(
+                        rd.result_ref == Entity.property_error_type,
+                        Not(Entity.first_no_paren_parent.is_a(T.RaiseExpr))
+                    ),
+
+                    Self.error(
+                        S("cannot call ")
+                        .concat(Entity.property_error_type.full_name)
+                        .concat(S(" outside of a raise expression"))
+                    ).singleton,
+
+                    No(T.SemanticResult.array)
+                )
+            )
         )
 
     @langkit_property(return_type=T.InferInstantiation)
diff --git a/testsuite/tests/contrib/lkt_semantic/property_error/test.lkt b/testsuite/tests/contrib/lkt_semantic/property_error/test.lkt
index cf34c3c30..d6c36dbbd 100644
--- a/testsuite/tests/contrib/lkt_semantic/property_error/test.lkt
+++ b/testsuite/tests/contrib/lkt_semantic/property_error/test.lkt
@@ -1,11 +1,18 @@
 fun prop1(): Bool = raise PropertyError("error")
 fun prop2(): Bool = (raise PropertyError("error"))
+fun prop3(): Bool = raise (PropertyError("error"))
+fun prop4(): Bool = raise (((PropertyError("error"))))
+
+# TODO: prop5 and prop6 should be rejected (we don't want any PropertyError
+# value living outside of the exception system).
+# @invalid fun prop5(): PropertyError = raise PropertyError()
+# @invalid fun prop6(): Bool = raise prop5()
 
 # Invalid because of missing raise keyword
-@invalid val prop3: Bool = PropertyError("error")
-@invalid val prop4: Bool = (PropertyError("error"))
+@invalid val prop7: Bool = PropertyError("error")
+@invalid val prop8: Bool = (PropertyError("error"))
 
-fun prop5(): Bool = {
+fun prop9(): Bool = {
    val n: Int = 1;
 
    raise PropertyError("Explicit error")
@@ -13,4 +20,4 @@ fun prop5(): Bool = {
 
 # Invalid because only PropertyError can be raised
 val i: Int = 1
-@invalid fun prop6(): Bool = raise i
+@invalid fun prop10(): Bool = raise i
diff --git a/testsuite/tests/contrib/lkt_semantic/property_error/test.out b/testsuite/tests/contrib/lkt_semantic/property_error/test.out
index 9cf7ba7b5..b7f1020ef 100644
--- a/testsuite/tests/contrib/lkt_semantic/property_error/test.out
+++ b/testsuite/tests/contrib/lkt_semantic/property_error/test.out
@@ -33,79 +33,129 @@ Expr <RaiseExpr test.lkt:2:22-2:50>
 Expr <ParenExpr test.lkt:2:21-2:51>
      has type <EnumTypeDecl prelude: "Bool">
 
-Id   <RefId "Bool" test.lkt:5:21-5:25>
+Id   <RefId "Bool" test.lkt:3:14-3:18>
      references <EnumTypeDecl prelude: "Bool">
 
-Id   <RefId "PropertyError" test.lkt:5:28-5:41>
+Id   <RefId "PropertyError" test.lkt:3:28-3:41>
      references <StructDecl prelude: "PropertyError">
 
-Expr <StringLit test.lkt:5:42-5:49>
+Expr <StringLit test.lkt:3:42-3:49>
      has type <StructDecl prelude: "String">
 
-test.lkt:5:28: error: Mismatched types: expected `Bool`, got `PropertyError`
-5 | @invalid val prop3: Bool = PropertyError("error")
-  |                            ^^^^^^^^^^^^^^^^^^^^^^
+Expr <CallExpr test.lkt:3:28-3:50>
+     has type <StructDecl prelude: "PropertyError">
+
+Expr <ParenExpr test.lkt:3:27-3:51>
+     has type <StructDecl prelude: "PropertyError">
+
+Expr <RaiseExpr test.lkt:3:21-3:51>
+     has type <EnumTypeDecl prelude: "Bool">
+
+Id   <RefId "Bool" test.lkt:4:14-4:18>
+     references <EnumTypeDecl prelude: "Bool">
+
+Id   <RefId "PropertyError" test.lkt:4:30-4:43>
+     references <StructDecl prelude: "PropertyError">
+
+Expr <StringLit test.lkt:4:44-4:51>
+     has type <StructDecl prelude: "String">
+
+Expr <CallExpr test.lkt:4:30-4:52>
+     has type <StructDecl prelude: "PropertyError">
+
+Expr <ParenExpr test.lkt:4:29-4:53>
+     has type <StructDecl prelude: "PropertyError">
 
-Id   <RefId "Bool" test.lkt:6:21-6:25>
+Expr <ParenExpr test.lkt:4:28-4:54>
+     has type <StructDecl prelude: "PropertyError">
+
+Expr <ParenExpr test.lkt:4:27-4:55>
+     has type <StructDecl prelude: "PropertyError">
+
+Expr <RaiseExpr test.lkt:4:21-4:55>
+     has type <EnumTypeDecl prelude: "Bool">
+
+Id   <RefId "Bool" test.lkt:12:21-12:25>
      references <EnumTypeDecl prelude: "Bool">
 
-Id   <RefId "PropertyError" test.lkt:6:29-6:42>
+test.lkt:12:28: error: cannot call PropertyError outside of a raise expression
+12 | @invalid val prop7: Bool = PropertyError("error")
+   |                            ^^^^^^^^^^^^^^^^^^^^^^
+
+Id   <RefId "PropertyError" test.lkt:12:28-12:41>
+     references <StructDecl prelude: "PropertyError">
+
+Expr <StringLit test.lkt:12:42-12:49>
+     has type <StructDecl prelude: "String">
+
+test.lkt:12:28: error: Mismatched types: expected `Bool`, got `PropertyError`
+12 | @invalid val prop7: Bool = PropertyError("error")
+   |                            ^^^^^^^^^^^^^^^^^^^^^^
+
+Id   <RefId "Bool" test.lkt:13:21-13:25>
+     references <EnumTypeDecl prelude: "Bool">
+
+test.lkt:13:29: error: cannot call PropertyError outside of a raise expression
+13 | @invalid val prop8: Bool = (PropertyError("error"))
+   |                             ^^^^^^^^^^^^^^^^^^^^^^
+
+Id   <RefId "PropertyError" test.lkt:13:29-13:42>
      references <StructDecl prelude: "PropertyError">
 
-Expr <StringLit test.lkt:6:43-6:50>
+Expr <StringLit test.lkt:13:43-13:50>
      has type <StructDecl prelude: "String">
 
-test.lkt:6:29: error: Mismatched types: expected `Bool`, got `PropertyError`
-6 | @invalid val prop4: Bool = (PropertyError("error"))
-  |                             ^^^^^^^^^^^^^^^^^^^^^^
+test.lkt:13:29: error: Mismatched types: expected `Bool`, got `PropertyError`
+13 | @invalid val prop8: Bool = (PropertyError("error"))
+   |                             ^^^^^^^^^^^^^^^^^^^^^^
 
-test.lkt:6:28: error: Mismatched types: expected `Bool`, got `PropertyError`
-6 | @invalid val prop4: Bool = (PropertyError("error"))
-  |                            ^^^^^^^^^^^^^^^^^^^^^^^^
+test.lkt:13:28: error: Mismatched types: expected `Bool`, got `PropertyError`
+13 | @invalid val prop8: Bool = (PropertyError("error"))
+   |                            ^^^^^^^^^^^^^^^^^^^^^^^^
 
-Id   <RefId "Bool" test.lkt:8:14-8:18>
+Id   <RefId "Bool" test.lkt:15:14-15:18>
      references <EnumTypeDecl prelude: "Bool">
 
-Id   <RefId "Int" test.lkt:9:11-9:14>
+Id   <RefId "Int" test.lkt:16:11-16:14>
      references <StructDecl prelude: "Int">
 
-Expr <NumLit test.lkt:9:17-9:18>
+Expr <NumLit test.lkt:16:17-16:18>
      has type <StructDecl prelude: "Int">
 
-Id   <RefId "PropertyError" test.lkt:11:10-11:23>
+Id   <RefId "PropertyError" test.lkt:18:10-18:23>
      references <StructDecl prelude: "PropertyError">
 
-Expr <StringLit test.lkt:11:24-11:40>
+Expr <StringLit test.lkt:18:24-18:40>
      has type <StructDecl prelude: "String">
 
-Expr <CallExpr test.lkt:11:10-11:41>
+Expr <CallExpr test.lkt:18:10-18:41>
      has type <StructDecl prelude: "PropertyError">
 
-Expr <RaiseExpr test.lkt:11:4-11:41>
+Expr <RaiseExpr test.lkt:18:4-18:41>
      has type <EnumTypeDecl prelude: "Bool">
 
-Expr <BlockExpr test.lkt:8:21-12:2>
+Expr <BlockExpr test.lkt:15:21-19:2>
      has type <EnumTypeDecl prelude: "Bool">
 
-Id   <RefId "Int" test.lkt:15:8-15:11>
+Id   <RefId "Int" test.lkt:22:8-22:11>
      references <StructDecl prelude: "Int">
 
-Expr <NumLit test.lkt:15:14-15:15>
+Expr <NumLit test.lkt:22:14-22:15>
      has type <StructDecl prelude: "Int">
 
-Id   <RefId "Bool" test.lkt:16:23-16:27>
+Id   <RefId "Bool" test.lkt:23:24-23:28>
      references <EnumTypeDecl prelude: "Bool">
 
-test.lkt:16:36: error: raised expression needs to be of type `PropertyError`, got `Int`
-16 | @invalid fun prop6(): Bool = raise i
-   |                                    ^
+test.lkt:23:37: error: raised expression needs to be of type `PropertyError`, got `Int`
+23 | @invalid fun prop10(): Bool = raise i
+   |                                     ^
 
-Id   <RefId "i" test.lkt:16:36-16:37>
-     references <ValDecl "i" test.lkt:15:1-15:15>
+Id   <RefId "i" test.lkt:23:37-23:38>
+     references <ValDecl "i" test.lkt:22:1-22:15>
 
-Expr <RefId "i" test.lkt:16:36-16:37>
+Expr <RefId "i" test.lkt:23:37-23:38>
      has type <StructDecl prelude: "Int">
 
-Expr <RaiseExpr test.lkt:16:30-16:37>
+Expr <RaiseExpr test.lkt:23:31-23:38>
      has type <EnumTypeDecl prelude: "Bool">