[flang-commits] [flang] 016557f - [flang] Better error handling for PDT constant expression (#130637)

[via flang-commits]

Author: Peter Klausler
Date: 2025-03-10T16:48:54-07:00
New Revision: 016557fab24ae4d99ab6aa98433cce23f2d03ac2

URL: https://github.com/llvm/llvm-project/commit/016557fab24ae4d99ab6aa98433cce23f2d03ac2
DIFF: https://github.com/llvm/llvm-project/commit/016557fab24ae4d99ab6aa98433cce23f2d03ac2.diff

LOG: [flang] Better error handling for PDT constant expression (#130637)

We currently don't consider an integer division to be a constant
expression unless its divisor is known and nonzero. This produces a
weird result in the linked test; do better.

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

Added: 
    flang/test/Semantics/pdt04.f90

Modified: 
    flang/lib/Evaluate/check-expression.cpp
    flang/lib/Semantics/type.cpp
    flang/test/Semantics/resolve105.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 823f8fd49baeb..3d338b04e64bb 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -69,13 +69,14 @@ class IsConstantExprHelper
   bool operator()(const Component &component) const {
     return (*this)(component.base());
   }
-  // Forbid integer division by zero in constants.
+  // Prevent integer division by known zeroes in constant expressions.
   template <int KIND>
   bool operator()(
       const Divide<Type<TypeCategory::Integer, KIND>> &division) const {
     using T = Type<TypeCategory::Integer, KIND>;
-    if (const auto divisor{GetScalarConstantValue<T>(division.right())}) {
-      return !divisor->IsZero() && (*this)(division.left());
+    if ((*this)(division.left()) && (*this)(division.right())) {
+      const auto divisor{GetScalarConstantValue<T>(division.right())};
+      return !divisor || !divisor->IsZero();
     } else {
       return false;
     }

diff  --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp
index e867d7ad6e253..c5a75c4d619c5 100644
--- a/flang/lib/Semantics/type.cpp
+++ b/flang/lib/Semantics/type.cpp
@@ -567,11 +567,18 @@ const DeclTypeSpec &InstantiateHelper::InstantiateIntrinsicType(
       kind = *value;
     } else {
       foldingContext().messages().Say(symbolName,
-          "KIND parameter value (%jd) of intrinsic type %s "
-          "did not resolve to a supported value"_err_en_US,
+          "KIND parameter value (%jd) of intrinsic type %s did not resolve to a supported value"_err_en_US,
           *value,
           parser::ToUpperCaseLetters(EnumToString(intrinsic.category())));
     }
+  } else {
+    std::string exprString;
+    llvm::raw_string_ostream sstream(exprString);
+    copy.AsFortran(sstream);
+    foldingContext().messages().Say(symbolName,
+        "KIND parameter expression (%s) of intrinsic type %s did not resolve to a constant value"_err_en_US,
+        exprString,
+        parser::ToUpperCaseLetters(EnumToString(intrinsic.category())));
   }
   switch (spec.category()) {
   case DeclTypeSpec::Numeric:

diff  --git a/flang/test/Semantics/pdt04.f90 b/flang/test/Semantics/pdt04.f90
new file mode 100644
index 0000000000000..7578a763cc947
--- /dev/null
+++ b/flang/test/Semantics/pdt04.f90
@@ -0,0 +1,11 @@
+!RUN: not %flang_fc1 %s 2>&1 | FileCheck %s
+!CHECK: error: KIND parameter expression (int(1_4/0_4,kind=8)) of intrinsic type CHARACTER did not resolve to a constant value
+!CHECK: in the context: instantiation of parameterized derived type 'ty(j=1_4,k=0_4)'
+!CHECK: warning: INTEGER(4) division by zero
+program main
+  type ty(j,k)
+    integer, kind :: j, k
+    character(kind=j/k) a
+  end type
+  type(ty(1,0)) x
+end

diff  --git a/flang/test/Semantics/resolve105.f90 b/flang/test/Semantics/resolve105.f90
index 13623207c0bf7..5c2c7e40b0bde 100644
--- a/flang/test/Semantics/resolve105.f90
+++ b/flang/test/Semantics/resolve105.f90
@@ -1,9 +1,9 @@
 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! Test instantiation of components that are procedure pointers.
-! 
 program test
   type dtype(kindParam)
     integer, kind :: kindParam = 4
+    !ERROR: KIND parameter expression (kindparam) of intrinsic type REAL did not resolve to a constant value
     !ERROR: KIND parameter value (66) of intrinsic type REAL did not resolve to a supported value
     !ERROR: KIND parameter value (55) of intrinsic type REAL did not resolve to a supported value
     procedure (real(kindParam)), pointer, nopass :: field => null()