[flang] Accept CONTIGUOUS attribute when redundant

[klausler]

As an extension, accept the redundant use of the CONTIGUOUS attribute when applied to scalars and to simply contiguous objects, with a portability warning.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

As an extension, accept the redundant use of the CONTIGUOUS attribute when applied to scalars and to simply contiguous objects, with a portability warning.

---

Full diff: https://github.com/llvm/llvm-project/pull/70853.diff

6 Files Affected:

• (modified) flang/docs/Extensions.md (+2)
• (modified) flang/lib/Semantics/check-declarations.cpp (+2-2)
• (modified) flang/test/Semantics/bind-c13.f90 (+3-3)
• (modified) flang/test/Semantics/call07.f90 (+2-2)
• (modified) flang/test/Semantics/contiguous01.f90 (+8-8)
• (modified) flang/test/Semantics/resolve90.f90 (+2-2)

diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 2786a8cca73b5b5..1aa0e03253455eb 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -222,6 +222,8 @@ end
   we also treat scalars as being trivially contiguous, so that they
   can be used in contexts like data targets in pointer assignments
   with bounds remapping.
+* The `CONTIGUOUS` attribute can be redundantly applied to simply
+  contiguous objects, including scalars, with a portability warning.
 * We support some combinations of specific procedures in generic
   interfaces that a strict reading of the standard would preclude
   when their calls must nonetheless be distinguishable.
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index fdd29f081324c77..6d69eb187bda089 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -2129,11 +2129,11 @@ void CheckHelper::CheckContiguous(const Symbol &symbol) {
           evaluate::IsAssumedRank(symbol))) {
   } else if (symbol.owner().IsDerivedType()) { // C752
     messages_.Say(
-        "CONTIGUOUS component '%s' must be an array with the POINTER attribute"_err_en_US,
+        "CONTIGUOUS component '%s' should be an array with the POINTER attribute"_port_en_US,
         symbol.name());
   } else {
     messages_.Say(
-        "CONTIGUOUS entity '%s' must be an array pointer, assumed-shape, or assumed-rank"_err_en_US,
+        "CONTIGUOUS entity '%s' should be an array pointer, assumed-shape, or assumed-rank"_port_en_US,
         symbol.name());
   }
 }
diff --git a/flang/test/Semantics/bind-c13.f90 b/flang/test/Semantics/bind-c13.f90
index 14e20a36f4f33c7..81815c1a95efa6a 100644
--- a/flang/test/Semantics/bind-c13.f90
+++ b/flang/test/Semantics/bind-c13.f90
@@ -1,12 +1,12 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 ! Interoperable objects that require descriptors cannot be CONTIGUOUS
 subroutine interop(ptr,ashape,arank,eshape,asize) bind(c)
   !ERROR: An interoperable pointer must not be CONTIGUOUS
   real, pointer, contiguous :: ptr(:)
   real, contiguous :: ashape(:) ! ok
   real, contiguous :: arank(..) ! ok
-  !ERROR: CONTIGUOUS entity 'eshape' must be an array pointer, assumed-shape, or assumed-rank
+  !PORTABILITY: CONTIGUOUS entity 'eshape' should be an array pointer, assumed-shape, or assumed-rank
   real, contiguous :: eshape(10)
-  !ERROR: CONTIGUOUS entity 'asize' must be an array pointer, assumed-shape, or assumed-rank
+  !PORTABILITY: CONTIGUOUS entity 'asize' should be an array pointer, assumed-shape, or assumed-rank
   real, contiguous :: asize(*)
 end
diff --git a/flang/test/Semantics/call07.f90 b/flang/test/Semantics/call07.f90
index ff372206fe8241a..3b5c2838fadf751 100644
--- a/flang/test/Semantics/call07.f90
+++ b/flang/test/Semantics/call07.f90
@@ -19,12 +19,12 @@ subroutine s04(p)
   end subroutine
 
   subroutine test
-    !ERROR: CONTIGUOUS entity 'a01' must be an array pointer, assumed-shape, or assumed-rank
+    !PORTABILITY: CONTIGUOUS entity 'a01' should be an array pointer, assumed-shape, or assumed-rank
     real, pointer, contiguous :: a01 ! C830
     real, pointer :: a02(:)
     real, target :: a03(10)
     real :: a04(10) ! not TARGET
-    !ERROR: CONTIGUOUS entity 'scalar' must be an array pointer, assumed-shape, or assumed-rank
+    !PORTABILITY: CONTIGUOUS entity 'scalar' should be an array pointer, assumed-shape, or assumed-rank
     real, contiguous :: scalar
     call s01(a03) ! ok
     !WARNING: Target of CONTIGUOUS pointer association is not known to be contiguous
diff --git a/flang/test/Semantics/contiguous01.f90 b/flang/test/Semantics/contiguous01.f90
index 77820b94bb654b2..1d3600aef6c555a 100644
--- a/flang/test/Semantics/contiguous01.f90
+++ b/flang/test/Semantics/contiguous01.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 module m0
   real, pointer, contiguous :: p1(:) ! ok
   real, pointer :: p2(:)
@@ -9,26 +9,26 @@ module m
   contiguous p1
   !ERROR: Cannot change CONTIGUOUS attribute on use-associated 'p2'
   contiguous p2
-  !ERROR: CONTIGUOUS entity 'x' must be an array pointer, assumed-shape, or assumed-rank
+  !PORTABILITY: CONTIGUOUS entity 'x' should be an array pointer, assumed-shape, or assumed-rank
   real, contiguous :: x
-  !ERROR: CONTIGUOUS entity 'scalar' must be an array pointer, assumed-shape, or assumed-rank
+  !PORTABILITY: CONTIGUOUS entity 'scalar' should be an array pointer, assumed-shape, or assumed-rank
   real, contiguous, pointer :: scalar
-  !ERROR: CONTIGUOUS entity 'allocatable' must be an array pointer, assumed-shape, or assumed-rank
+  !PORTABILITY: CONTIGUOUS entity 'allocatable' should be an array pointer, assumed-shape, or assumed-rank
   real, contiguous, allocatable :: allocatable
  contains
-  !ERROR: CONTIGUOUS entity 'func' must be an array pointer, assumed-shape, or assumed-rank
+  !PORTABILITY: CONTIGUOUS entity 'func' should be an array pointer, assumed-shape, or assumed-rank
   function func(ashape,arank) result(r)
     real, contiguous :: ashape(:) ! ok
     real, contiguous :: arank(..) ! ok
-    !ERROR: CONTIGUOUS entity 'r' must be an array pointer, assumed-shape, or assumed-rank
+    !PORTABILITY: CONTIGUOUS entity 'r' should be an array pointer, assumed-shape, or assumed-rank
     real :: r(10)
-    !ERROR: CONTIGUOUS entity 'r2' must be an array pointer, assumed-shape, or assumed-rank
+    !PORTABILITY: CONTIGUOUS entity 'r2' should be an array pointer, assumed-shape, or assumed-rank
     real :: r2(10)
     contiguous func
     contiguous r
     contiguous e
     contiguous r2
-    !ERROR: CONTIGUOUS entity 'e' must be an array pointer, assumed-shape, or assumed-rank
+    !PORTABILITY: CONTIGUOUS entity 'e' should be an array pointer, assumed-shape, or assumed-rank
     entry e() result(r2)
   end
   function fp()
diff --git a/flang/test/Semantics/resolve90.f90 b/flang/test/Semantics/resolve90.f90
index 16cb641adc663ab..baa108f4d0839ee 100644
--- a/flang/test/Semantics/resolve90.f90
+++ b/flang/test/Semantics/resolve90.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 ! Testing for pointer constant, along with :
 ! C751 A component shall not have both the ALLOCATABLE and POINTER attributes.
 ! C752 If the CONTIGUOUS attribute is specified, the component shall be an 
@@ -12,7 +12,7 @@ subroutine s()
     !ERROR: 'pointerallocatablefield' may not have both the POINTER and ALLOCATABLE attributes
     real, pointer, allocatable :: pointerAllocatableField
     real, dimension(:), contiguous, pointer :: goodContigField
-    !ERROR: CONTIGUOUS component 'badcontigfield' must be an array with the POINTER attribute
+    !PORTABILITY: CONTIGUOUS component 'badcontigfield' should be an array with the POINTER attribute
     real, dimension(:), contiguous, allocatable :: badContigField
     character :: charField * 3
     !ERROR: A length specifier cannot be used to declare the non-character entity 'realfield'

[clementval]

Thanks Peter! LGTM