[flang-commits] [flang] 3293272 - [flang][semantics] Reject DATA-style initializer on EXTERNAL/INTRINSIC (#222256)

[via flang-commits]

Author: Adarsh Mishra
Date: 2026-10-08T18:59:56-04:00
New Revision: 32932727b33e8b5c04093eef51481713fbeb6823

URL: https://github.com/llvm/llvm-project/commit/32932727b33e8b5c04093eef51481713fbeb6823
DIFF: https://github.com/llvm/llvm-project/commit/32932727b33e8b5c04093eef51481713fbeb6823.diff

LOG: [flang][semantics] Reject DATA-style initializer on EXTERNAL/INTRINSIC (#222256)

An `entity-decl` carrying a legacy `/initialization/` (an extension) was silently
accepted, and the initializer dropped, when the name had already been
declared `EXTERNAL` or `INTRINSIC`:

```fortran
subroutine s
  external foo
  integer foo /1/   ! accepted, no initialization emitted
end subroutine
```

`DataChecker::Leave(const parser::EntityDecl &)` passed the value list to
`AccumulateDataInitializations` without checking the symbol's class, so the
initialization never reached the emitted code and no diagnostic was produced.
Reversing the two statements already errors, so the behaviour was also
order-dependent. For an intrinsic name that is not an unrestricted specific
function (`sum`), the accumulated value instead tripped
`CHECK(designator.has_value())` in `data-to-inits.cpp` and crashed the
compiler.

A procedure name is not a data-stmt-object (F2023 C880, R842), so reject it here.
Procedure pointer initialization is an accepted extension (8.6.7), so
`IsProcedurePointer` symbols still take the existing path.

Fixes #222168

Assisted-by: Qoder (AI assistant)

Added: 
    flang/test/Semantics/data28.f90

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

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-data.cpp b/flang/lib/Semantics/check-data.cpp
index 921128ced5d61b..75b2e91f6290f5 100644
--- a/flang/lib/Semantics/check-data.cpp
+++ b/flang/lib/Semantics/check-data.cpp
@@ -266,7 +266,16 @@ void DataChecker::Leave(const parser::EntityDecl &decl) {
         std::get_if<std::list<common::Indirection<parser::DataStmtValue>>>(
             &init->u)};
     if (name && list && !exprAnalyzer_.context().HasError(*name)) {
-      AccumulateDataInitializations(inits_, exprAnalyzer_, *name, *list);
+      // A procedure name is not a data-stmt-object (F2023 C880, R842), but
+      // procedure pointer initialization is supported as an extension, so
+      // exclude procedure pointers here.
+      if (IsProcedure(*name) && !IsProcedurePointer(*name)) {
+        exprAnalyzer_.context().Say(std::get<parser::Name>(decl.t).source,
+            "Procedure '%s' may not have a DATA-style initializer"_err_en_US,
+            name->name());
+      } else {
+        AccumulateDataInitializations(inits_, exprAnalyzer_, *name, *list);
+      }
     }
   }
 }

diff  --git a/flang/test/Semantics/data28.f90 b/flang/test/Semantics/data28.f90
new file mode 100644
index 00000000000000..572f3dab123aae
--- /dev/null
+++ b/flang/test/Semantics/data28.f90
@@ -0,0 +1,36 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! A procedure (EXTERNAL/INTRINSIC) may not have a DATA-style initializer.
+! The initializer used to be silently accepted and dropped (#222168), or,
+! for an intrinsic that is not an unrestricted specific function, crashed
+! the compiler (CHECK(designator.has_value()) in data-to-inits.cpp).
+subroutine s1
+  external foo
+  !ERROR: Procedure 'foo' may not have a DATA-style initializer
+  integer foo /1/
+end subroutine
+subroutine s2
+  intrinsic sin
+  !ERROR: Procedure 'sin' may not have a DATA-style initializer
+  integer sin /1/
+end subroutine
+subroutine s3 ! used to crash: SUM is not an unrestricted specific intrinsic
+  intrinsic sum
+  !ERROR: Procedure 'sum' may not have a DATA-style initializer
+  integer sum /1/
+end subroutine
+subroutine s4(f) ! dummy procedure
+  external f
+  !ERROR: Procedure 'f' may not have a DATA-style initializer
+  integer f /1/
+end subroutine
+subroutine s5 ! no INTRINSIC/EXTERNAL: a plain local object named like an
+  integer sum /1/ ! intrinsic must stay accepted (guard keys on symbol class)
+  print *, sum
+end subroutine
+subroutine s6 ! procedure POINTER initialization must stay accepted (8.6.7)
+  interface
+    integer function tgt()
+    end function
+  end interface
+  procedure(tgt), pointer :: p => null()
+end subroutine