Merge branch 'topic/1035' into 'master'

Support prefixed-view notation for calls to primitive subprograms of untagged types

Closes #1035

See merge request eng/libadalang/libadalang!1464

ada/ast.py

@@ -7904,6 +7904,9 @@ def dottable_subps():
         Return the list of all subprograms that can be called with the dot-
         notation on values of this type. We look for them in the public part,
         private part and body part of the package this type is declared in.
+
+        This property doesn't implement Ada standard but the GNAT experimental
+        feature allowing dot-notation for untagged types.
         """
         scope = Var(Entity.declarative_scope)
         pkg = Var(
@@ -7916,10 +7919,12 @@ def dottable_subps():
             )
         )
         return Cond(
-            Not(Entity.is_tagged_type
-                # Private types can have a tagged completion
-                | Entity.private_completion._.is_tagged_type),
-            No(T.inner_env_assoc.array),
+            # Ada standard would requier to check that this type is tagged to
+            # be called with the dot-notation. We do not comply to the standard
+            # here in order to support a GNAT experimental feature which allows
+            # to use the dot-notation on untagged types too. See
+            # https://github.com/AdaCore/ada-spark-rfcs/blob/master/\
+            #   prototyped/rfc-prefixed-untagged.rst.
 
             pkg.is_null,
             No(T.inner_env_assoc.array),
@@ -19262,23 +19267,14 @@ def dottable_subp_of():
         """
         Returns whether the subprogram containing this spec is a subprogram
         callable via the dot notation.
+
+        This property doesn't implement Ada standard but the GNAT experimental
+        feature allowing dot-notation for untagged types.
         """
+        # See also comments in BaseTypeDecl.dottable_subps
         return origin.bind(Self.origin_node, If(
             Entity.nb_max_params > 0,
-            Entity.potential_dottable_type.then(lambda t: Cond(
-                t.is_a(ClasswideTypeDecl),
-                t.cast(ClasswideTypeDecl).type_decl,
-
-                # NOTE: We are not actually implementing the correct Ada
-                # semantics here, because you can call primitives via the dot
-                # notation on private types with a tagged completion.
-                # However, since private types don't have components, this
-                # should not ever be a problem with legal Ada.
-                t.full_view.is_tagged_type,
-                t,
-
-                No(T.BaseTypeDecl.entity)
-            )),
+            Entity.potential_dottable_type._.specific_type,
             No(T.BaseTypeDecl.entity)
         ))
 

testsuite/tests/name_resolution/prefixed_untagged/test.adb

@@ -0,0 +1,34 @@
+procedure Test is
+   package Pkg is
+      type T is null record;
+      procedure P (B : T);
+   end Pkg;
+
+   package body Pkg is
+      procedure P (B : T) is null;
+
+      procedure Q (B : T) is
+      begin
+         B.P;
+         pragma Test_Statement;
+      end Q;
+   end Pkg;
+
+   package Pkg2 is
+      type T is null record;
+      subtype U is T;
+      procedure P (B : U);
+   end Pkg2;
+
+   package body Pkg2 is
+      procedure P (B : U) is null;
+
+      procedure Q (B : U) is
+      begin
+         B.P;
+         pragma Test_Statement;
+      end Q;
+   end Pkg2;
+begin
+   null;
+end Test;

testsuite/tests/name_resolution/prefixed_untagged/test.out

@@ -0,0 +1,37 @@
+Analyzing test.adb
+##################
+
+Resolving xrefs for node <CallStmt test.adb:12:10-12:14>
+********************************************************
+
+Expr: <DottedName test.adb:12:10-12:13>
+  references:    <DefiningName "P" test.adb:4:17-4:18>
+  type:          None
+  expected type: None
+Expr: <Id "B" test.adb:12:10-12:11>
+  references:    <DefiningName "B" test.adb:10:20-10:21>
+  type:          <ConcreteTypeDecl ["T"] test.adb:3:7-3:29>
+  expected type: <ConcreteTypeDecl ["T"] test.adb:3:7-3:29>
+Expr: <Id "P" test.adb:12:12-12:13>
+  references:    <DefiningName "P" test.adb:4:17-4:18>
+  type:          None
+  expected type: None
+
+Resolving xrefs for node <CallStmt test.adb:28:10-28:14>
+********************************************************
+
+Expr: <DottedName test.adb:28:10-28:13>
+  references:    <DefiningName "P" test.adb:20:17-20:18>
+  type:          None
+  expected type: None
+Expr: <Id "B" test.adb:28:10-28:11>
+  references:    <DefiningName "B" test.adb:26:20-26:21>
+  type:          <SubtypeDecl ["U"] test.adb:19:7-19:22>
+  expected type: <SubtypeDecl ["U"] test.adb:19:7-19:22>
+Expr: <Id "P" test.adb:28:12-28:13>
+  references:    <DefiningName "P" test.adb:20:17-20:18>
+  type:          None
+  expected type: None
+
+
+Done.

testsuite/tests/name_resolution/prefixed_untagged/test.yaml

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