[flang-commits] [flang] 868187d - [flang] Handle type-bound procedures with alternate returns

[Peter Steinfeld via flang-commits]

Author: Peter Steinfeld
Date: 2021-03-11T10:20:34-08:00
New Revision: 868187df2132d54f7c282b7ca2ead4682631bf2a

URL: https://github.com/llvm/llvm-project/commit/868187df2132d54f7c282b7ca2ead4682631bf2a
DIFF: https://github.com/llvm/llvm-project/commit/868187df2132d54f7c282b7ca2ead4682631bf2a.diff

LOG: [flang] Handle type-bound procedures with alternate returns

If you specify a type-bound procedure with an alternate return, there
will be no symbol associated with that dummy argument.  In such cases,
the compiler's list of dummy arguments will contain a nullptr.  In our
analysis of the PASS arguments of type-bound procedures, we were
assuming that all dummy arguments had non-null symbols associated with
them and were using that assumption to get the name of the dummy
argument.  This caused the compiler to try to dereference a nullptr.

I fixed this by explicitly checking for a nullptr and, in such cases, emitting
an error message.  I also added tests that contain type-bound procedures with
alternate returns in both legal and illegal constructs to ensure that semantic
analysis is working for them.

Differential Revision: https://reviews.llvm.org/D98430

Added: 
    

Modified: 
    flang/lib/Semantics/check-declarations.cpp
    flang/test/Semantics/bindings01.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index bd92a3778a94..ebc0bcf606b5 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -1359,6 +1359,13 @@ void CheckHelper::CheckPassArg(
       context_.SetError(*interface);
       return;
     }
+    Symbol *argSym{dummyArgs[0]};
+    if (!argSym) {
+      messages_.Say(interface->name(),
+          "Cannot use an alternate return as the passed-object dummy "
+          "argument"_err_en_US);
+      return;
+    }
     passName = dummyArgs[0]->name();
   }
   std::optional<int> passArgIndex{};

diff  --git a/flang/test/Semantics/bindings01.f90 b/flang/test/Semantics/bindings01.f90
index 8a1e6568a687..b83804786c60 100644
--- a/flang/test/Semantics/bindings01.f90
+++ b/flang/test/Semantics/bindings01.f90
@@ -132,7 +132,7 @@ subroutine mp(x)
   end subroutine
 end module m1
 
-module t2
+module m2
   type parent
     real realField
   contains
@@ -147,7 +147,71 @@ module t2
 contains
   subroutine proc 
   end subroutine
-end module t2
+end module m2
+
+module m3
+  type t
+  contains
+    procedure b
+  end type
+contains
+  !ERROR: Cannot use an alternate return as the passed-object dummy argument
+  subroutine b(*)
+    return 1
+  end subroutine
+end module m3
+
+module m4
+  type t
+  contains
+    procedure b
+  end type
+contains
+  ! Check to see that alternate returns work with default PASS arguments
+  subroutine b(this, *)
+    class(t) :: this
+    return 1
+  end subroutine
+end module m4
+
+module m5
+  type t
+  contains
+    !ERROR: Passed-object dummy argument 'passarg' of procedure 'b' must be of type 't' but is 'INTEGER(4)'
+    procedure, pass(passArg) ::  b
+  end type
+contains
+  subroutine b(*, passArg)
+    integer :: passArg
+    return 1
+  end subroutine
+end module m5
+
+module m6
+  type t
+  contains
+    !ERROR: Passed-object dummy argument 'passarg' of procedure 'b' must be polymorphic because 't' is extensible
+    procedure, pass(passArg) ::  b
+  end type
+contains
+  subroutine b(*, passArg)
+    type(t) :: passArg
+    return 1
+  end subroutine
+end module m6
+
+module m7
+  type t
+  contains
+  ! Check to see that alternate returns work with PASS arguments
+    procedure, pass(passArg) ::  b
+  end type
+contains
+  subroutine b(*, passArg)
+    class(t) :: passArg
+    return 1
+  end subroutine
+end module m7
 
 program test
   use m1