[flang-commits] [flang] 8867e83 - [flang] Fix ICE for passing a label for non alternate return arguments

[Daniil Dudkin via flang-commits]

Author: Daniil Dudkin
Date: 2022-05-04T12:32:33+03:00
New Revision: 8867e83d00322c97630a3019b7f6c580dbcb37b4

URL: https://github.com/llvm/llvm-project/commit/8867e83d00322c97630a3019b7f6c580dbcb37b4
DIFF: https://github.com/llvm/llvm-project/commit/8867e83d00322c97630a3019b7f6c580dbcb37b4.diff

LOG: [flang] Fix ICE for passing a label for non alternate return arguments

When we pass an alternate return specifier to a regular (not an asterisk)
dummy argument, flang would throw an internal compiler error of
derefencing a null pointer.
To avoid the ICE, a check was added.

Reviewed By: kiranchandramohan

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

Added: 
    flang/test/Semantics/call26.f90

Modified: 
    flang/lib/Semantics/check-call.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index e2b556ae32dfa..ab1b5e7adf16b 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -684,53 +684,68 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
   }
   auto restorer{
       messages.SetLocation(arg.sourceLocation().value_or(messages.at()))};
+  auto checkActualArgForLabel = [&](evaluate::ActualArgument &arg) {
+    if (arg.isAlternateReturn()) {
+      messages.Say(
+          "Alternate return label '%d' cannot be associated with %s"_err_en_US,
+          arg.GetLabel(), dummyName);
+      return true;
+    } else {
+      return false;
+    }
+  };
   common::visit(
       common::visitors{
           [&](const characteristics::DummyDataObject &object) {
-            ConvertBOZLiteralArg(arg, object.type.type());
-            if (auto *expr{arg.UnwrapExpr()}) {
-              if (auto type{characteristics::TypeAndShape::Characterize(
-                      *expr, context)}) {
-                arg.set_dummyIntent(object.intent);
-                bool isElemental{object.type.Rank() == 0 && proc.IsElemental()};
-                CheckExplicitDataArg(object, dummyName, *expr, *type,
-                    isElemental, context, scope, intrinsic,
-                    allowIntegerConversions);
-              } else if (object.type.type().IsTypelessIntrinsicArgument() &&
-                  IsBOZLiteral(*expr)) {
-                // ok
-              } else if (object.type.type().IsTypelessIntrinsicArgument() &&
-                  evaluate::IsNullPointer(*expr)) {
-                // ok, ASSOCIATED(NULL())
-              } else if ((object.attrs.test(characteristics::DummyDataObject::
-                                  Attr::Pointer) ||
-                             object.attrs.test(characteristics::
-                                     DummyDataObject::Attr::Optional)) &&
-                  evaluate::IsNullPointer(*expr)) {
-                // ok, FOO(NULL())
+            if (!checkActualArgForLabel(arg)) {
+              ConvertBOZLiteralArg(arg, object.type.type());
+              if (auto *expr{arg.UnwrapExpr()}) {
+                if (auto type{characteristics::TypeAndShape::Characterize(
+                        *expr, context)}) {
+                  arg.set_dummyIntent(object.intent);
+                  bool isElemental{
+                      object.type.Rank() == 0 && proc.IsElemental()};
+                  CheckExplicitDataArg(object, dummyName, *expr, *type,
+                      isElemental, context, scope, intrinsic,
+                      allowIntegerConversions);
+                } else if (object.type.type().IsTypelessIntrinsicArgument() &&
+                    IsBOZLiteral(*expr)) {
+                  // ok
+                } else if (object.type.type().IsTypelessIntrinsicArgument() &&
+                    evaluate::IsNullPointer(*expr)) {
+                  // ok, ASSOCIATED(NULL())
+                } else if ((object.attrs.test(characteristics::DummyDataObject::
+                                    Attr::Pointer) ||
+                               object.attrs.test(characteristics::
+                                       DummyDataObject::Attr::Optional)) &&
+                    evaluate::IsNullPointer(*expr)) {
+                  // ok, FOO(NULL())
+                } else {
+                  messages.Say(
+                      "Actual argument '%s' associated with %s is not a variable or typed expression"_err_en_US,
+                      expr->AsFortran(), dummyName);
+                }
               } else {
-                messages.Say(
-                    "Actual argument '%s' associated with %s is not a variable or typed expression"_err_en_US,
-                    expr->AsFortran(), dummyName);
-              }
-            } else {
-              const Symbol &assumed{DEREF(arg.GetAssumedTypeDummy())};
-              if (!object.type.type().IsAssumedType()) {
-                messages.Say(
-                    "Assumed-type '%s' may be associated only with an assumed-type %s"_err_en_US,
-                    assumed.name(), dummyName);
-              } else if (object.type.attrs().test(evaluate::characteristics::
-                                 TypeAndShape::Attr::AssumedRank) &&
-                  !IsAssumedShape(assumed) &&
-                  !evaluate::IsAssumedRank(assumed)) {
-                messages.Say( // C711
-                    "Assumed-type '%s' must be either assumed shape or assumed rank to be associated with assumed rank %s"_err_en_US,
-                    assumed.name(), dummyName);
+                const Symbol &assumed{DEREF(arg.GetAssumedTypeDummy())};
+                if (!object.type.type().IsAssumedType()) {
+                  messages.Say(
+                      "Assumed-type '%s' may be associated only with an assumed-type %s"_err_en_US,
+                      assumed.name(), dummyName);
+                } else if (object.type.attrs().test(evaluate::characteristics::
+                                   TypeAndShape::Attr::AssumedRank) &&
+                    !IsAssumedShape(assumed) &&
+                    !evaluate::IsAssumedRank(assumed)) {
+                  messages.Say( // C711
+                      "Assumed-type '%s' must be either assumed shape or assumed rank to be associated with assumed rank %s"_err_en_US,
+                      assumed.name(), dummyName);
+                }
               }
             }
           },
           [&](const characteristics::DummyProcedure &dummy) {
-            CheckProcedureArg(arg, proc, dummy, dummyName, context);
+            if (!checkActualArgForLabel(arg)) {
+              CheckProcedureArg(arg, proc, dummy, dummyName, context);
+            }
           },
           [&](const characteristics::AlternateReturn &) {
             // All semantic checking is done elsewhere

diff  --git a/flang/test/Semantics/call26.f90 b/flang/test/Semantics/call26.f90
new file mode 100644
index 0000000000000..74f2ee19d2c47
--- /dev/null
+++ b/flang/test/Semantics/call26.f90
@@ -0,0 +1,17 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+module m
+  contains
+    subroutine simple_arg(x)
+      integer, intent(in) :: x
+    end subroutine simple_arg
+    subroutine procedure_arg(x)
+      procedure(simple_arg) :: x
+    end subroutine procedure_arg
+    subroutine s
+      !ERROR: Alternate return label '42' cannot be associated with dummy argument 'x='
+      call simple_arg(*42)
+      !ERROR: Alternate return label '42' cannot be associated with dummy argument 'x='
+      call procedure_arg(*42)
+      42 stop
+    end subroutine s
+end module m