[flang-commits] [flang] [flang] Catch attempt to type a subroutine (PR #82704)

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/82704

The presence of a type in the prefix of a SUBROUTINE statement should elicit an error message, not a crash.

Fixes https://github.com/llvm/llvm-project/issues/80530.

>From d87417fe1007f5a88a1e676691229b96f79eef99 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Thu, 22 Feb 2024 15:22:52 -0800
Subject: [PATCH] [flang] Catch attempt to type a subroutine

The presence of a type in the prefix of a SUBROUTINE statement
should elicit an error message, not a crash.

Fixes https://github.com/llvm/llvm-project/issues/80530.
---
 flang/lib/Semantics/resolve-names.cpp | 16 ++++++++++------
 flang/test/Semantics/typed-subr.f90   |  4 ++++
 2 files changed, 14 insertions(+), 6 deletions(-)
 create mode 100644 flang/test/Semantics/typed-subr.f90

diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 36deab969456d0..4b40648392709b 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -3709,13 +3709,17 @@ bool SubprogramVisitor::Pre(const parser::Suffix &suffix) {
 bool SubprogramVisitor::Pre(const parser::PrefixSpec &x) {
   // Save this to process after UseStmt and ImplicitPart
   if (const auto *parsedType{std::get_if<parser::DeclarationTypeSpec>(&x.u)}) {
-    FuncResultStack::FuncInfo &info{DEREF(funcResultStack().Top())};
-    if (info.parsedType) { // C1543
-      Say(currStmtSource().value(),
-          "FUNCTION prefix cannot specify the type more than once"_err_en_US);
+    if (FuncResultStack::FuncInfo * info{funcResultStack().Top()}) {
+      if (info->parsedType) { // C1543
+        Say(currStmtSource().value(),
+            "FUNCTION prefix cannot specify the type more than once"_err_en_US);
+      } else {
+        info->parsedType = parsedType;
+        info->source = currStmtSource();
+      }
     } else {
-      info.parsedType = parsedType;
-      info.source = currStmtSource();
+      Say(currStmtSource().value(),
+          "SUBROUTINE prefix cannot specify a type"_err_en_US);
     }
     return false;
   } else {
diff --git a/flang/test/Semantics/typed-subr.f90 b/flang/test/Semantics/typed-subr.f90
new file mode 100644
index 00000000000000..c6637c95bdfd74
--- /dev/null
+++ b/flang/test/Semantics/typed-subr.f90
@@ -0,0 +1,4 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! ERROR: SUBROUTINE prefix cannot specify a type
+integer subroutine foo
+end