[flang] Catch misuse of a procedure designator as an output item

[klausler]

Summary

f18 was diagnosing the misuse of a procedure pointer as an output item,
but not the more general case of a procedure designator other than
a pointer.

flang/lib/Semantics/check-io.cpp

 
 void IoChecker::Enter(const parser::OutputItem &item) {
   flags_.set(Flag::DataList);
   if (const auto *x{std::get_if<parser::Expr>(&item.u)}) {
     if (const auto *expr{GetExpr(context_, *x)}) {
       if (evaluate::IsBOZLiteral(*expr)) {
         context_.Say(parser::FindSourceLocation(*x), // C7109
             "Output item must not be a BOZ literal constant"_err_en_US);
-      }
-      const Symbol *last{GetLastSymbol(*expr)};
-      if (last && IsProcedurePointer(*last)) {
+      } else if (IsProcedure(*expr)) {
         context_.Say(parser::FindSourceLocation(*x),
-            "Output item must not be a procedure pointer"_err_en_US); // C1233
+            "Output item must not be a procedure"_err_en_US); // C1233
       }
       CheckForBadIoType(*expr,
           flags_.test(Flag::FmtOrNml)
               ? GenericKind::DefinedIo::WriteFormatted
               : GenericKind::DefinedIo::WriteUnformatted,
           parser::FindSourceLocation(item));
     }
   }

flang/lib/Semantics/expression.cpp

MaybeExpr ExpressionAnalyzer::Analyze(const parser::Designator &d) {
   }
   // These checks have to be deferred to these "top level" data-refs where
   // we can be sure that there are no following subscripts (yet).
   MaybeExpr result{Analyze(d.u)};
   if (result) {
     std::optional<DataRef> dataRef{ExtractDataRef(std::move(result))};
     if (!dataRef) {
       dataRef = ExtractDataRef(std::move(result), /*intoSubstring=*/true);
-      if (!dataRef) {
-        dataRef = ExtractDataRef(std::move(result),
-            /*intoSubstring=*/false, /*intoComplexPart=*/true);
-      }
-    }
+    }
     if (dataRef && !CheckDataRef(*dataRef)) {
       result.reset();
     }
   }
   return result;
 }
 
 // A utility subroutine to repackage optional expressions of various levels

flang/test/Semantics/io04.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
   character(kind=1,len=50) internal_file
   character(kind=1,len=100) msg
   character(20) sign
   character, parameter :: const_internal_file*(*) = "(I6)"
   integer*1 stat1, id1
   integer*2 stat2
   integer*4 stat4
   integer*8 stat8
   integer :: iunit = 10
   integer, parameter :: junit = 11
   integer, pointer :: a(:)
   integer, parameter :: const_id = 66666
   procedure(), pointer :: procptr
+  external external
+  intrinsic acos
 
   namelist /nnn/ nn1, nn2
 
   sign = 'suppress'
 
   open(10)
 
   write(*)
! RUN: %python %S/test_errors.py %s %flang_fc1
   write(id=id1, unit=10, asynchronous='Yes') 'Ok'
 
   !ERROR: ID variable 'const_id' is not definable
   !BECAUSE: '66666_4' is not a variable or pointer
   write(10, *, asynchronous='yes', id=const_id, iostat=stat2) 'Ok'
 
   write(*, '(X)')
 
-  !ERROR: Output item must not be a procedure pointer
-  print*, n1, procptr, n2
+  !ERROR: Output item must not be a procedure
+  print*, procptr
+  !ERROR: Output item must not be a procedure
+  print*, acos
+  !ERROR: Output item must not be a procedure
+  print*, external
 
 1 format (A)
 9 continue
 end