[flang] Relax ALLOCATABLE/POINTER actual argument checks under INTENT(IN)

[klausler]

Summary

Per 15.5.2.5 p2, when both a dummy data object and its associated
actual argument are ALLOCATABLE or POINTER, there are rules requiring
that both be unlimited polymorphic if either is, and that both be
polymorphic if either is. The justifications for the first restriction
is that the called procedure might change the type of an unlimited
polymorphic dummy argument, but as this cannot occur for a dummy
argument with INTENT(IN), we can relax the check to an optional
portability warning. The justification for the second restriction
is that some implementations would have to create a type descriptor
to associate a monomorphic allocatable/pointer actual argument with
a polymorphic dummy argument, and that doesn't apply to f18 since we
use descriptors for them anyways.

Relaxing these needless checks allows more library procedures to
use "class(*), dimension(..), pointer, intent(in)" dummy arguments
in explicit interfaces.

[vzakhari]

Thank you! Looks great!

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

ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     ClassicCComments, AdditionalFormats, BigIntLiterals, RealDoControls,
     EquivalenceNumericWithCharacter, EquivalenceNonDefaultNumeric,
     EquivalenceSameNonSequence, AdditionalIntrinsics, AnonymousParents,
     OldLabelDoEndStatements, LogicalIntegerAssignment, EmptySourceFile,
     ProgramReturn, ImplicitNoneTypeNever, ImplicitNoneTypeAlways,
     ForwardRefImplicitNone, OpenAccessAppend, BOZAsDefaultInteger,
     DistinguishableSpecifics, DefaultSave, PointerInSeqType, NonCharacterFormat,
     SaveMainProgram, SaveBigMainProgramVariables,
-    DistinctArrayConstructorLengths, PPCVector)
+    DistinctArrayConstructorLengths, PPCVector, RelaxedIntentInChecking)
 
 // Portability and suspicious usage warnings for conforming code
 ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
     NonTargetPassedToTarget, PointerToPossibleNoncontiguous,
     ShortCharacterActual, ExprPassedToVolatile, ImplicitInterfaceActual,
     PolymorphicTransferArg, PointerComponentTransferArg, TransferSizePresence)
 
 using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;

flang/lib/Semantics/check-call.cpp

if (dummyIsPointer) {
     } else if (!actualIsPointer) {
       messages.Say(
           "Actual argument associated with POINTER %s must also be POINTER unless INTENT(IN)"_err_en_US,
           dummyName);
     }
   }
 
   // 15.5.2.5 -- actual & dummy are both POINTER or both ALLOCATABLE
-  if ((actualIsPointer && dummyIsPointer) ||
+  // For INTENT(IN) we relax two checks that are in Fortran to
+  // prevent the callee from changing the type or to avoid having
+  // to use a descriptor.
+  if (!typesCompatible) {
+    // Don't pile on the errors emitted above
+  } else if ((actualIsPointer && dummyIsPointer) ||
       (actualIsAllocatable && dummyIsAllocatable)) {
     bool actualIsUnlimited{actualType.type().IsUnlimitedPolymorphic()};
     bool dummyIsUnlimited{dummy.type.type().IsUnlimitedPolymorphic()};
     if (actualIsUnlimited != dummyIsUnlimited) {
-      if (typesCompatible) {
+      if (dummyIsUnlimited && dummy.intent == common::Intent::In &&
+          context.IsEnabled(common::LanguageFeature::RelaxedIntentInChecking)) {
+        if (context.ShouldWarn(
+                common::LanguageFeature::RelaxedIntentInChecking)) {
+          messages.Say(
+              "If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both should be so"_port_en_US);
+        }
+      } else {
         messages.Say(
             "If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both must be so"_err_en_US);
       }
     } else if (dummyIsPolymorphic != actualIsPolymorphic) {
-      if (dummy.intent == common::Intent::In && typesCompatible) {
-        // extension: allow with warning, rule is only relevant for definables
+      if (dummyIsPolymorphic && dummy.intent == common::Intent::In &&
+          context.IsEnabled(common::LanguageFeature::RelaxedIntentInChecking)) {
+        if (context.ShouldWarn(
+                common::LanguageFeature::RelaxedIntentInChecking)) {
           messages.Say(
               "If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both should be so"_port_en_US);
+        }
       } else {
         messages.Say(
             "If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so"_err_en_US);
       }
-    } else if (!actualIsUnlimited && typesCompatible) {
+    } else if (!actualIsUnlimited) {
       if (!actualType.type().IsTkCompatibleWith(dummy.type.type())) {
-        if (dummy.intent == common::Intent::In) {
-          // extension: allow with warning, rule is only relevant for definables
+        if (dummy.intent == common::Intent::In &&
+            context.IsEnabled(
+                common::LanguageFeature::RelaxedIntentInChecking)) {
+          if (context.ShouldWarn(
+                  common::LanguageFeature::RelaxedIntentInChecking)) {
             messages.Say(
                 "POINTER or ALLOCATABLE dummy and actual arguments should have the same declared type and kind"_port_en_US);
+          }
         } else {
           messages.Say(
               "POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type and kind"_err_en_US);
         }
       }
       // 15.5.2.5(4)
       const auto *derived{evaluate::GetDerivedTypeSpec(actualType.type())};
       if ((derived &&

flang/test/Semantics/call36.f90

+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
+! Test the RelaxedIntentInChecking extension
+module m
+ contains
+  subroutine intentInUnlimited(x)
+    class(*), dimension(..), pointer, intent(in) :: x
+  end
+  subroutine intentInOutUnlimited(x)
+    class(*), dimension(..), pointer, intent(in out) :: x
+  end
+  subroutine test
+    integer, target :: scalar
+    real, pointer :: arrayptr(:)
+    class(*), pointer :: unlimited(:)
+    call intentInUnlimited(scalar)
+    !ERROR: Actual argument associated with POINTER dummy argument 'x=' must also be POINTER unless INTENT(IN)
+    call intentInOutUnlimited(scalar)
+    !PORTABILITY: If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both should be so
+    call intentInUnlimited(arrayptr)
+    !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both must be so
+    call intentInOutUnlimited(arrayptr)
+    call intentInUnlimited(unlimited) ! ok
+    call intentInOutUnlimited(unlimited) ! ok
+  end
+end