[flang][test] Fix semantics tests with respect to warnings

[ekieri]

Summary

Make tests expect the (correctly) emitted warnings using the WARNING
directive. This directive is non-functional now, but will be recognised
by test_errors.py when D125804 is landed. This patch is a preparation
for D125804.

For most tests, we add missing WARNING directives for emitted warnings,
but there are exceptions:

• for int-literals.f90 and resolve31.f90 we pass -pedantic to the frontend driver, so that the expected warnings are actually emitted.
• for block-data01.f90 and resolve42.f90 we change the tests so that warnings, which appear unintentional, are not emitted. While testing the warning in question (padding added for alignment in common block) would be desired, that is beyond the scope of this patch. This warning is target-dependent.

[PeteSteinfeld]

I had a question about the change to flang/test/Semantics/block-data01.f90. Otherwise, all builds and tests correctly and looks good.

flang/test/Semantics/block-data01.f90

14

This change looks unnecessary. Did you mean to make it?

[ekieri]

flang/test/Semantics/block-data01.f90

14

Yes, this is deliberate. It relates to the final part of the patch summary. On x86_64, pointers require 8-byte alignment, and default reals are 4 bytes. With the real before the pointer, 4 bytes of padding has to be added in the common block to respect the alignment requirements, and this triggers a warning. I here change the order of the variables so that the warning, which appear unintentional, is not emitted.

flang/test/Semantics/bindings01.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! Confirm enforcement of constraints and restrictions in 7.5.7.3
 ! and C733, C734 and C779, C780, C782, C783, C784, and C785.
 
 module m
+  !WARNING: A derived type with the BIND attribute is empty
   !ERROR: An ABSTRACT derived type must be extensible
   type, abstract, bind(c) :: badAbstract1
   end type
   !ERROR: An ABSTRACT derived type must be extensible
   type, abstract :: badAbstract2
     sequence
     real :: badAbstract2Field
   end type
module m
   type, extends(missing) :: concrete
   end type
   type, extends(missing) :: intermediate
    contains
     procedure :: am1 => s7
   end type
   type, extends(intermediate) :: concrete2  ! ensure no false missing binding error
   end type
+  !WARNING: A derived type with the BIND attribute is empty
   type, bind(c) :: inextensible1
   end type
   !ERROR: The parent type is not extensible
   type, extends(inextensible1) :: badExtends1
   end type
   type :: inextensible2
     sequence
     real :: inextensible2Field

flang/test/Semantics/block-data01.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! Test BLOCK DATA subprogram (14.3)
 block data foo
   !ERROR: IMPORT is not allowed in a BLOCK DATA subprogram
   import
   real :: pi = asin(-1.0) ! ok
   !ERROR: An initialized variable in BLOCK DATA must be in a COMMON block
   integer :: notInCommon = 1
   integer :: uninitialized ! ok
   !ERROR: 'q' may not appear in a BLOCK DATA subprogram
   procedure(sin), pointer :: q => cos
   !ERROR: 'p' may not be a procedure as it is in a COMMON block
   procedure(sin), pointer :: p => cos
-  common /block/ pi, p
+  common /block/ p, pi
   !ERROR: An initialized variable in BLOCK DATA must be in a COMMON block
   integer :: inDataButNotCommon
   data inDataButNotCommon /1/
   integer :: inCommonA, inCommonB
   !ERROR: 'incommona' in COMMON block /a/ must not be storage associated with 'incommonb' in COMMON block /b/ by EQUIVALENCE
   common /a/ inCommonA, /b/ inCommonB
   equivalence(inCommonA, inCommonB)
   integer :: inCommonD, initialized ! ok

flang/test/Semantics/call03.f90

subroutine test06 ! 15.5.2.4(4)
     type(pdt(3)) :: var3
     type(pdt(4)) :: var4
     type(pdtWithDefault) :: defaultVardefault
     type(pdtWithDefault(3)) :: defaultVar3
     type(pdtWithDefault(4)) :: defaultVar4
     character :: ch1
     !ERROR: Actual argument variable length '1' is less than expected length '2'
     call ch2(ch1)
-    !WARN: Actual argument expression length '0' is less than expected length '2'
+    !WARNING: Actual argument expression length '0' is less than expected length '2'
     call ch2("")
     call pdtdefault(vardefault)
     call pdtdefault(var3)
     call pdtdefault(var4) ! error
     call pdt3(vardefault) ! error
     !ERROR: Actual argument type 'pdt(n=3_4)' is not compatible with dummy argument type 'pdt(n=4_4)'
     call pdt3(var3) ! error
     call pdt3(var4)

flang/test/Semantics/case01.f90

select case (grade3)
     case (.false.)
      !ERROR: CASE (.true._1) conflicts with previous cases
      case (.true.)
     !ERROR: CASE (.false._1) conflicts with previous cases
      case (grade5)
   end select
 
   select case (grade2)
-     case (51:50) ! warning
+     !WARNING: CASE has lower bound greater than upper bound
+     case (51:50)
      case (100:)
      case (:30)
      case (40)
      case (90)
      case (91:99)
      !ERROR: CASE (81_4:90_4) conflicts with previous cases
      case (81:90)
      !ERROR: CASE (:80_4) conflicts with previous cases
select case(i)
     case(:0)
   end select
 end
 
 subroutine test_overflow
   integer :: j
   select case(1_1)
   case (127)
-  !WARN: CASE value (128_4) overflows type (INTEGER(1)) of SELECT CASE expression
+  !WARNING: CASE value (128_4) overflows type (INTEGER(1)) of SELECT CASE expression
   case (128)
-  !WARN: CASE value (129_4) overflows type (INTEGER(1)) of SELECT CASE expression
-  !WARN: CASE value (130_4) overflows type (INTEGER(1)) of SELECT CASE expression
+  !WARNING: CASE value (129_4) overflows type (INTEGER(1)) of SELECT CASE expression
+  !WARNING: CASE value (130_4) overflows type (INTEGER(1)) of SELECT CASE expression
   case (129:130)
-  !WARN: CASE value (-130_4) overflows type (INTEGER(1)) of SELECT CASE expression
-  !WARN: CASE value (-129_4) overflows type (INTEGER(1)) of SELECT CASE expression
+  !WARNING: CASE value (-130_4) overflows type (INTEGER(1)) of SELECT CASE expression
+  !WARNING: CASE value (-129_4) overflows type (INTEGER(1)) of SELECT CASE expression
   case (-130:-129)
   case (-128)
   !ERROR: Must be a scalar value, but is a rank-1 array
   case ([1, 2])
   !ERROR: Must be a constant value
   case (j)
   case default
   end select
 end

flang/test/Semantics/common-blocks.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 
 ! Test check that enforce that a common block is initialized
 ! only once in a file.
 
 subroutine init_1
   common x, y
   common /a/ xa, ya
   common /b/ xb, yb
-  !CHECK: portability: Blank COMMON object 'x' in a DATA statement is not standard
+  !WARNING: Blank COMMON object 'x' in a DATA statement is not standard
   data x /42./, xa /42./, yb/42./
 end subroutine
 
 subroutine init_conflict
   !ERROR: Multiple initialization of COMMON block //
   common x, y
   !ERROR: Multiple initialization of COMMON block /a/
   common /a/ xa, ya
   common /b/ xb, yb
   equivalence (yb, yb_eq)
+  !WARNING: Blank COMMON object 'x' in a DATA statement is not standard
   !ERROR: Multiple initialization of COMMON block /b/
   data x /66./, xa /66./, yb_eq /66./
 end subroutine

flang/test/Semantics/data06.f90

real function rfunc(x)
       real, intent(in) :: x
     end function
   end interface
   real, pointer :: rp
   !ERROR: Procedure 'rfunc' may not be used to initialize 'rp', which is not a procedure pointer
   data rp/rfunc/
   procedure(rfunc), pointer :: rpp
   real, target :: rt
+  !WARNING: Procedure pointer 'rpp' in a DATA statement is not standard
   !ERROR: Data object 'rt' may not be used to initialize 'rpp', which is a procedure pointer
   data rpp/rt/
   !ERROR: Initializer for 'rt' must not be a pointer
   data rt/null()/
   !ERROR: Initializer for 'rt' must not be a procedure
   data rt/rfunc/
   integer :: jx, jy
   !WARNING: DATA statement value initializes 'jx' of type 'INTEGER(4)' with CHARACTER
   data jx/'abc'/
   !ERROR: DATA statement value could not be converted to the type 'INTEGER(4)' of the object 'jx'
   data jx/t1()/
   !ERROR: DATA statement value 'jy' for 'jx' is not a constant
   data jx/jy/
 end subroutine

flang/test/Semantics/dosemantics02.f90

IMPURE FUNCTION random() RESULT(i)
       i = 35
     END FUNCTION random
 END SUBROUTINE do_concurrent_c1121
 
 SUBROUTINE s1()
   INTEGER, PARAMETER :: constInt = 0
 
   ! Warn on this one for backwards compatibility
+  !WARNING: DO step expression should not be zero
   DO 10 I = 1, 10, 0
   10 CONTINUE
 
   ! Warn on this one for backwards compatibility
+  !WARNING: DO step expression should not be zero
   DO 20 I = 1, 10, 5 - 5
   20 CONTINUE
 
   ! Error, no compatibility requirement for DO CONCURRENT
   !ERROR: DO CONCURRENT step expression may not be zero
   DO CONCURRENT (I = 1 : 10 : 0)
   END DO
 
   ! Error, this time with an integer constant
   !ERROR: DO CONCURRENT step expression may not be zero
   DO CONCURRENT (I = 1 : 10 : constInt)
   END DO
 end subroutine s1

flang/test/Semantics/dosemantics12.f90

subroutine s12()
   call intentOutSub(jvar, ivar)
   do ivar = 1,10
 !ERROR: Cannot redefine DO variable 'ivar'
     call intentOutSub(jvar, ivar)
   end do
 
   call intentInOutSub(jvar, ivar)
   do ivar = 1,10
+    !WARNING: Possible redefinition of DO variable 'ivar'
     call intentInOutSub(jvar, ivar)
   end do
 
 contains
   subroutine intentInSub(arg1, arg2)
     integer, intent(in) :: arg1
     integer, intent(in) :: arg2
   end subroutine intentInSub
!ERROR: Cannot redefine DO variable 'ivar'
 
   ! Error for passing a DO variable to an INTENT(OUT) dummy, more complex 
   ! expression
   do ivar = 1, 10
 !ERROR: Cannot redefine DO variable 'ivar'
     jvar = 83 + intentInFunc(intentOutFunc(ivar))
   end do
 
-  ! Warning for passing a DO variable to an INTENT(INOUT) dummy
   do ivar = 1, 10
+    !WARNING: Possible redefinition of DO variable 'ivar'
     jvar = intentInOutFunc(ivar)
   end do
 
 contains
   function intentInFunc(dummyArg)
     integer, intent(in) :: dummyArg
     integer  :: intentInFunc
 

flang/test/Semantics/forall01.f90

 subroutine forall3
   real :: x
   forall(i=1:10)
     !ERROR: Cannot redefine FORALL variable 'i'
     i = 1
   end forall
   forall(i=1:10)
     forall(j=1:10)
+      !WARNING: FORALL index variable 'j' not used on left-hand side of assignment
       !ERROR: Cannot redefine FORALL variable 'i'
       i = 1
     end forall
   end forall
   !ERROR: Cannot redefine FORALL variable 'i'
   forall(i=1:10) i = 1
 end
 

 
 ! Note: this gets warnings but not errors
 subroutine forall5
   real, target :: x(10), y(10)
   forall(i=1:10)
     x(i) = y(i)
   end forall
   forall(i=1:10)
-    x = y  ! warning: i not used on LHS
+    !WARNING: FORALL index variable 'i' not used on left-hand side of assignment
+    x = y
     forall(j=1:10)
-      x(i) = y(i)  ! warning: j not used on LHS
-      x(j) = y(j)  ! warning: i not used on LHS
+      !WARNING: FORALL index variable 'j' not used on left-hand side of assignment
+      x(i) = y(i)
+      !WARNING: FORALL index variable 'i' not used on left-hand side of assignment
+      x(j) = y(j)
     endforall
   endforall
   do concurrent(i=1:10)
     x = y
+    !WARNING: FORALL index variable 'i' not used on left-hand side of assignment
     forall(i=1:10) x = y
   end do
 end
 
 subroutine forall6
   type t
     real, pointer :: p
   end type
   type(t) :: a(10)
   real, target :: b(10)
   forall(i=1:10)
     a(i)%p => b(i)
-    a(1)%p => b(i)  ! warning: i not used on LHS
+    !WARNING: FORALL index variable 'i' not used on left-hand side of assignment
+    a(1)%p => b(i)
   end forall
 end

flang/test/Semantics/int-literals.f90

-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 ! Fortran syntax considers signed int literals in complex literals
 ! to be a distinct production, not an application of unary +/- to
 ! an unsigned int literal, so they're used here to test overflow
 ! on signed int literal constants.  The literals are tested here
 ! as part of expressions that name resolution must analyze.
 
 complex, parameter :: okj1 = 127_1, okz1 = (+127_1, -128_1)
 !ERROR: Integer literal is too large for INTEGER(KIND=1)

flang/test/Semantics/resolve11.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 module m
   public i
   integer, private :: j
   !ERROR: The accessibility of 'i' has already been specified as PUBLIC
   private i
-  !The accessibility of 'j' has already been specified as PRIVATE
+  !WARNING: The accessibility of 'j' has already been specified as PRIVATE
   private j
 end
 
 module m2
   interface operator(.foo.)
     module procedure ifoo
   end interface
   public :: operator(.foo.)

flang/test/Semantics/resolve31.f90

-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 ! C735 If EXTENDS appears, SEQUENCE shall not appear.
 ! C738 The same private-or-sequence shall not appear more than once in a
 ! given derived-type-def .
 !
 ! C740 If SEQUENCE appears,
 !  the type shall have at least one component,
 !  each data component shall be declared to be of an intrinsic type or of a sequence type,
 !  the derived type shall not have any type parameter,
subroutine s2
   type, extends(t0) :: t1
   end type
 end subroutine
 
 module m4
   type :: t1
     private
     sequence
-    private  ! not a fatal error
-    sequence ! not a fatal error
+    !WARNING: PRIVATE may not appear more than once in derived type components
+    private
+    !WARNING: SEQUENCE may not appear more than once in derived type components
+    sequence
     real :: t1Field
   end type
   type :: t1a
   end type
   !ERROR: A sequence type may not have the EXTENDS attribute
   type, extends(t1a) :: t2
     sequence
     integer i
type :: sequenceType
     real :: sequenceField
   end type sequenceType
   type :: testType
     sequence
     !ERROR: A sequence type data component must either be of an intrinsic type or a derived sequence type
     class(*), allocatable :: typeStarField
     !ERROR: A sequence type data component must either be of an intrinsic type or a derived sequence type
     type(plainType) :: testField1
-    !Pointers are ok as an extension
+    !WARNING: A sequence type data component that is a pointer to a non-sequence type is not standard
     type(plainType), pointer :: testField1p
     type(sequenceType) :: testField2
     procedure(real), pointer, nopass :: procField
   end type testType
   !ERROR: A sequence type may not have type parameters
   type :: paramType(param)
     integer, kind :: param
     sequence

flang/test/Semantics/resolve35.f90

subroutine s6b
   end forall
 end
 
 subroutine s7
   !ERROR: 'i' is already declared in this scoping unit
   do concurrent(integer::i=1:5) local(j, i) &
       !ERROR: 'j' is already declared in this scoping unit
       local_init(k, j) &
+      !WARNING: Variable 'a' with SHARED locality implicitly declared
       shared(a)
     a = j + 1
   end do
 end
 
 subroutine s8
   implicit none
   !ERROR: No explicit type declared for 'i'

flang/test/Semantics/resolve42.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 subroutine s1
-  !ERROR: Array 'z' without ALLOCATABLE or POINTER attribute must have explicit shape
-  common x, y(4), z(:)
+  !ERROR: Array 'x' without ALLOCATABLE or POINTER attribute must have explicit shape
+  common x(:), y(4), z
 end
 
 subroutine s2
   common /c1/ x, y, z
   !ERROR: 'y' is already in a COMMON block
   common y
 end
 
subroutine s5
   integer x(2)
   !ERROR: The dimensions of 'x' have already been declared
   common x(4), y(4)
   !ERROR: The dimensions of 'y' have already been declared
   real y(2)
 end
 
 function f6(x) result(r)
-  !ERROR: Dummy argument 'x' may not appear in a COMMON block
   !ERROR: ALLOCATABLE object 'y' may not appear in a COMMON block
-  common x,y,z
+  !ERROR: Dummy argument 'x' may not appear in a COMMON block
+  common y,x,z
   allocatable y
   !ERROR: Function result 'r' may not appear in a COMMON block
   common r
 end
 
 module m7
   !ERROR: Variable 'w' with BIND attribute may not appear in a COMMON block
   !ERROR: Variable 'z' with BIND attribute may not appear in a COMMON block

flang/test/Semantics/resolve59.f90

function f5(x)
     procedure(rfunc), pointer :: f5
     f5 => rfunc
     ! OK call to f5 pointer
     x = acos(f5(x+1))
     !ERROR: Actual argument for 'x=' may not be a procedure
     x = acos(f5)
   end function
   ! Sanity test: f18 handles C1560 violation by ignoring RESULT
-  function f6() result(f6) !OKI (warning)
+  !WARNING: The function name should not appear in RESULT, references to 'f6' inside the function will be considered as references to the result only
+  function f6() result(f6)
   end function
-  function f7() result(f7) !OKI (warning)
+  !WARNING: The function name should not appear in RESULT, references to 'f7' inside the function will be considered as references to the result only
+  function f7() result(f7)
     real :: x, f7
     !ERROR: Recursive call to 'f7' requires a distinct RESULT in its declaration
     x = acos(f7())
     f7 = x
     x = acos(f7) !OK
   end function
 end module
 

flang/test/Semantics/resolve85.f90

!    ABSTRACT, PUBLIC, PRIVATE, BIND(C), EXTENDS(parent-type-name)
   type, private, abstract, private :: derived3
   end type derived3
 
   !ERROR: Attributes 'PUBLIC' and 'PRIVATE' conflict with each other
   type, public, abstract, private :: derived4
   end type derived4
 
   !WARNING: Attribute 'BIND(C)' cannot be used more than once
+  !WARNING: A derived type with the BIND attribute is empty
   type, bind(c), public, bind(c) :: derived5
   end type derived5
 
   type, public :: derived6
   end type derived6
 
   !ERROR: Attribute 'EXTENDS' cannot be used more than once
   type, extends(derived6), public, extends(derived6) :: derived7
   end type derived7
 
 end module m