[flang] Ignore -fno-realloc-lhs for polymorphic allocatable LHS with warning (#192697)

When -fno-realloc-lhs is specified and the LHS of an assignment is a
polymorphic allocatable (class(*) or class(T)), reallocation semantics
are required by the Fortran 2003 standard for dynamic type tracking and
cannot be safely skipped. Previously, the compiler generated invalid FIR
in such cases (type mismatch between i32 and
!fir.class<!fir.heap<none>>), causing a compilation error.

With this change, when -fno-realloc-lhs is in effect and a polymorphic
allocatable LHS is detected, the compiler emits a warning that the
option is being ignored for that assignment and proceeds with
reallocation semantics.

flang/include/flang/Support/Fortran-features.h

@@ -84,7 +84,8 @@ ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
     HostAssociatedIntentOutInSpecExpr, NonVolatilePointerToVolatile,
     RealConstantWidening, VolatileOrAsynchronousTemporary, UnusedVariable,
     UsedUndefinedVariable, BadValueInDeadCode, AssumedTypeSizeDummy,
-    MisplacedIgnoreTKR, NamelistParameter, ImpureFinalInPure)
+    MisplacedIgnoreTKR, NamelistParameter, ImpureFinalInPure,
+    IgnoredNoReallocateLHS)
 
 using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
 using UsageWarnings = EnumSet<UsageWarning, UsageWarning_enumSize>;

flang/include/flang/Support/LangOptions.def

@@ -60,6 +60,10 @@ LANGOPT(OpenMPNoThreadState, 1, 0)
 LANGOPT(OpenMPNoNestedParallelism, 1, 0)
 /// Use SIMD only OpenMP support.
 LANGOPT(OpenMPSimd, 1, false)
+/// -fno-realloc-lhs: disable reallocation of allocatable LHS on assignment.
+/// When set, polymorphic allocatable LHS still requires reallocation (F2003+);
+/// a warning is emitted in that case.
+LANGOPT(NoReallocateLHS, 1, false)
 /// Enable fast MOD operations for REAL
 LANGOPT(FastRealMod, 1, false)
 LANGOPT(VScaleMin, 32, 0)  ///< Minimum vscale range value

flang/lib/Frontend/CompilerInvocation.cpp

@@ -1661,8 +1661,10 @@ bool CompilerInvocation::createFromArgs(
 
   // -frealloc-lhs is the default.
   if (!args.hasFlag(clang::options::OPT_frealloc_lhs,
-                    clang::options::OPT_fno_realloc_lhs, true))
+                    clang::options::OPT_fno_realloc_lhs, true)) {
     invoc.loweringOpts.setReallocateLHS(false);
+    invoc.getLangOpts().NoReallocateLHS = true;
+  }
 
   invoc.loweringOpts.setRepackArrays(args.hasFlag(
       clang::options::OPT_frepack_arrays, clang::options::OPT_fno_repack_arrays,

flang/lib/Lower/Bridge.cpp

@@ -5650,15 +5650,23 @@ private:
 
     // Gather some information about the assignment that will impact how it is
     // lowered.
-    const bool isWholeAllocatableAssignment =
+    const bool lhsIsWholeAllocatable =
         !userDefinedAssignment && !isInsideHlfirWhere() &&
-        Fortran::lower::isWholeAllocatable(assign.lhs) &&
-        bridge.getLoweringOptions().getReallocateLHS();
+        Fortran::lower::isWholeAllocatable(assign.lhs);
+    std::optional<Fortran::evaluate::DynamicType> lhsType =
+        assign.lhs.GetType();
+    // Polymorphic allocatable LHS always requires reallocation semantics
+    // regardless of -fno-realloc-lhs: assignment to a polymorphic variable
+    // is a F2003+ feature that requires dynamic type tracking, which cannot
+    // be safely skipped.  A warning is emitted by the semantics phase.
+    const bool lhsIsPolymorphic =
+        lhsType.has_value() && lhsType->IsPolymorphic();
+    const bool isWholeAllocatableAssignment =
+        lhsIsWholeAllocatable &&
+        (bridge.getLoweringOptions().getReallocateLHS() || lhsIsPolymorphic);
     const bool isUserDefAssignToPointerOrAllocatable =
         userDefinedAssignment &&
         firstDummyIsPointerOrAllocatable(*userDefinedAssignment);
-    std::optional<Fortran::evaluate::DynamicType> lhsType =
-        assign.lhs.GetType();
     const bool keepLhsLengthInAllocatableAssignment =
         isWholeAllocatableAssignment && lhsType.has_value() &&
         lhsType->category() == Fortran::common::TypeCategory::Character &&

flang/lib/Semantics/expression.cpp

@@ -3634,6 +3634,9 @@ const Assignment *ExpressionAnalyzer::Analyze(const parser::AssignmentStmt &x) {
               Say("Left-hand side of intrinsic assignment may not be polymorphic unless assignment is to an entire allocatable"_err_en_US);
             } else if (evaluate::IsCoarray(*lastWhole)) {
               Say("Left-hand side of intrinsic assignment may not be polymorphic if it is a coarray"_err_en_US);
+            } else if (context_.langOptions().NoReallocateLHS) {
+              Warn(common::UsageWarning::IgnoredNoReallocateLHS,
+                  "-fno-realloc-lhs is ignored for assignment to polymorphic allocatable"_warn_en_US);
             }
           }
           if (auto *derived{GetDerivedTypeSpec(*dyType)}) {

flang/lib/Support/Fortran-features.cpp

@@ -162,6 +162,7 @@ LanguageFeatureControl::LanguageFeatureControl() {
   warnUsage_.set(UsageWarning::BadValueInDeadCode);
   warnUsage_.set(UsageWarning::MisplacedIgnoreTKR);
   warnUsage_.set(UsageWarning::ImpureFinalInPure);
+  warnUsage_.set(UsageWarning::IgnoredNoReallocateLHS);
   warnLanguage_.set(LanguageFeature::OpenMPThreadprivateEquivalence);
 }
 

flang/test/Lower/reallocate-lhs.f90

@@ -3,7 +3,9 @@
 ! RUN: bbc %s -o - -emit-hlfir -frealloc-lhs=false | FileCheck %s --check-prefixes=ALL,NOREALLOCLHS
 ! RUN: %flang_fc1 %s -o - -emit-hlfir | FileCheck %s --check-prefixes=ALL,REALLOCLHS
 ! RUN: %flang_fc1 %s -o - -emit-hlfir -frealloc-lhs | FileCheck %s --check-prefixes=ALL,REALLOCLHS
-! RUN: %flang_fc1 %s -o - -emit-hlfir -fno-realloc-lhs | FileCheck %s --check-prefixes=ALL,NOREALLOCLHS
+! RUN: %flang_fc1 %s -o - -emit-hlfir -fno-realloc-lhs 2>&1 | FileCheck %s --check-prefixes=ALL,NOREALLOCLHS
+
+! -fno-realloc-lhs must be ignored for polymorphic allocatable LHS (test3 below).
 
 subroutine test1(a, b)
   integer, allocatable :: a(:), b(:)
@@ -30,3 +32,15 @@ end subroutine test2
 ! NOREALLOCLHS:  %[[VAL_7:.*]] = fir.load %[[VAL_3]]#0 : !fir.ref<!fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>>
 ! NOREALLOCLHS:  hlfir.assign %{{.*}} to %[[VAL_7]] : !fir.box<!fir.array<?x!fir.char<1,?>>>, !fir.box<!fir.heap<!fir.array<?x!fir.char<1,?>>>>
 
+! Polymorphic allocatable LHS: reallocation semantics must be used regardless of
+! -fno-realloc-lhs, because the Fortran standard requires dynamic type tracking
+! for polymorphic assignments (a F2003+ feature that cannot be safely skipped).
+subroutine test3(x)
+  class(*), allocatable :: x
+  x = 1
+end subroutine test3
+
+! ALL-LABEL:   func.func @_QPtest3(
+! ALL:           %[[VAL_1:.*]]:2 = hlfir.declare{{.*}}{fortran_attrs = #fir.var_attrs<allocatable>, uniq_name = "_QFtest3Ex"}
+! ALL:           hlfir.assign %{{.*}} to %[[VAL_1]]#0 realloc : i32, !fir.ref<!fir.class<!fir.heap<none>>>
+

flang/test/Semantics/no-realloc-lhs-poly.f90

@@ -0,0 +1,26 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -fno-realloc-lhs -Werror
+
+! When -fno-realloc-lhs is specified, assignments to a polymorphic allocatable
+! LHS must still use reallocation semantics (F2003 requirement).  A warning is
+! issued so the user knows the option is being ignored for this case.
+
+subroutine test_unlimited_poly(x)
+  class(*), allocatable :: x
+! WARNING: -fno-realloc-lhs is ignored for assignment to polymorphic allocatable [-Wignored-no-reallocate-lhs]
+  x = 1
+end subroutine
+
+subroutine test_class_poly(x)
+  type :: t
+    integer :: i
+  end type
+  class(t), allocatable :: x
+! WARNING: -fno-realloc-lhs is ignored for assignment to polymorphic allocatable [-Wignored-no-reallocate-lhs]
+  x = t(42)
+end subroutine
+
+! Non-polymorphic allocatable: no warning, option is honoured.
+subroutine test_non_poly(x)
+  integer, allocatable :: x
+  x = 1
+end subroutine