[flang][NFC] Add misc lowering tests

This patch adds some lowering tests.

This patch is part of the upstreaming effort from fir-dev branch.

Reviewed By: PeteSteinfeld

Differential Revision: https://reviews.llvm.org/D122308

Co-authored-by: Jean Perier <jperier@nvidia.com>
Co-authored-by: Eric Schweitz <eschweitz@nvidia.com>

flang/test/Lower/associate-construct-2.f90

@@ -0,0 +1,50 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func @_QPtest1(
+! CHECK-SAME:     %[[VAL_0:.*]]: !fir.ref<!fir.array<100xf32>>{{.*}}, %[[VAL_1:.*]]: !fir.ref<i32>{{.*}}, %[[VAL_2:.*]]: !fir.ref<i32>{{.*}}, %[[VAL_3:.*]]: !fir.ref<i32>{{.*}}) {
+! CHECK:         %[[VAL_4:.*]] = arith.constant 100 : index
+! CHECK:         %[[VAL_5:.*]] = fir.load %[[VAL_1]] : !fir.ref<i32>
+! CHECK:         %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> i64
+! CHECK:         %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i64) -> index
+! CHECK:         %[[VAL_8:.*]] = fir.load %[[VAL_3]] : !fir.ref<i32>
+! CHECK:         %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i32) -> i64
+! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i64) -> index
+! CHECK:         %[[VAL_11:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK:         %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i32) -> i64
+! CHECK:         %[[VAL_13:.*]] = fir.convert %[[VAL_12]] : (i64) -> index
+! CHECK:         %[[VAL_14:.*]] = fir.shape %[[VAL_4]] : (index) -> !fir.shape<1>
+! CHECK:         %[[VAL_15:.*]] = fir.slice %[[VAL_7]], %[[VAL_13]], %[[VAL_10]] : (index, index, index) -> !fir.slice<1>
+! CHECK:         %[[VAL_16:.*]] = fir.embox %[[VAL_0]](%[[VAL_14]]) {{\[}}%[[VAL_15]]] : (!fir.ref<!fir.array<100xf32>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<?xf32>>
+! CHECK:         fir.call @_QPbob(%[[VAL_16]]) : (!fir.box<!fir.array<?xf32>>) -> ()
+! CHECK:         return
+! CHECK:       }
+
+subroutine test1(a,i,j,k)
+
+  real a(100)
+  integer i, j, k
+  interface
+    subroutine bob(a)
+      real :: a(:)
+    end subroutine bob
+  end interface
+
+  associate (name => a(i:j:k))
+    call bob(name)
+  end associate
+end subroutine test1
+
+! CHECK-LABEL: func @_QPtest2(
+! CHECK-SAME: %[[nadd:.*]]: !fir.ref<i32>{{.*}})
+subroutine test2(n)
+  integer :: n
+  integer, external :: foo
+  ! CHECK: %[[n:.*]] = fir.load %[[nadd]] : !fir.ref<i32>
+  ! CHECK: %[[n10:.*]] = arith.addi %[[n]], %c10{{.*}} : i32
+  ! CHECK: fir.store %[[n10]] to %{{.*}} : !fir.ref<i32>
+  ! CHECK: %[[foo:.*]] = fir.call @_QPfoo(%{{.*}}) : (!fir.ref<i32>) -> i32
+  ! CHECK: fir.store %[[foo]] to %{{.*}} : !fir.ref<i32>
+  associate (i => n, j => n + 10, k => foo(20))
+    print *, i, j, k, n
+  end associate
+end subroutine test2

flang/test/Lower/assumed-shape-callee.f90

@@ -0,0 +1,100 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! Test assumed shape dummy argument on callee side
+
+! TODO: These tests rely on looking at how a new fir.box is made for an assumed shape
+! to see if lowering lowered and mapped the assumed shape symbol properties.
+! However, the argument fir.box of the assumed shape could also be used instead
+! of making a new fir.box and this would break all these tests. In fact, for non
+! contiguous arrays, this is the case. Find a better way to tests symbol lowering/mapping.
+
+! CHECK-LABEL: func @_QPtest_assumed_shape_1(%arg0: !fir.box<!fir.array<?xi32>> {fir.bindc_name = "x", fir.contiguous}) 
+subroutine test_assumed_shape_1(x)
+  integer, contiguous :: x(:)
+  ! CHECK: %[[addr:.*]] = fir.box_addr %arg0 : (!fir.box<!fir.array<?xi32>>) -> !fir.ref<!fir.array<?xi32>>
+  ! CHECK: %[[c0:.*]] = arith.constant 0 : index
+  ! CHECK: %[[dims:.*]]:3 = fir.box_dims %arg0, %[[c0]] : (!fir.box<!fir.array<?xi32>>, index) -> (index, index, index)
+  ! CHECK: %[[c1:.*]] = arith.constant 1 : index
+
+  print *, x
+  ! Test extent/lower bound use in the IO statement
+  ! CHECK: %[[cookie:.*]] = fir.call @_FortranAioBeginExternalListOutput
+  ! CHECK: %[[shape:.*]] = fir.shape_shift %[[c1]], %[[dims]]#1 : (index, index) -> !fir.shapeshift<1>
+  ! CHECK: %[[newbox:.*]] = fir.embox %[[addr]](%[[shape]]) : (!fir.ref<!fir.array<?xi32>>, !fir.shapeshift<1>) -> !fir.box<!fir.array<?xi32>>
+  ! CHECK: %[[castedBox:.*]] = fir.convert %[[newbox]] : (!fir.box<!fir.array<?xi32>>) -> !fir.box<none>
+  ! CHECK: fir.call @_FortranAioOutputDescriptor(%[[cookie]], %[[castedBox]]) : (!fir.ref<i8>, !fir.box<none>) -> i1
+end subroutine
+
+! lower bounds all ones
+! CHECK-LABEL:  func @_QPtest_assumed_shape_2(%arg0: !fir.box<!fir.array<?x?xf32>> {fir.bindc_name = "x", fir.contiguous})
+subroutine test_assumed_shape_2(x)
+  real, contiguous :: x(1:, 1:)
+  ! CHECK: fir.box_addr
+  ! CHECK: %[[dims1:.*]]:3 = fir.box_dims
+  ! CHECK: %[[dims2:.*]]:3 = fir.box_dims
+  print *, x
+  ! CHECK: fir.call @_FortranAioBeginExternalListOutput
+  ! CHECK: fir.shape %[[dims1]]#1, %[[dims2]]#1
+end subroutine
+
+! explicit lower bounds different from 1
+! CHECK-LABEL: func @_QPtest_assumed_shape_3(%arg0: !fir.box<!fir.array<?x?x?xi32>> {fir.bindc_name = "x", fir.contiguous})
+subroutine test_assumed_shape_3(x)
+  integer, contiguous :: x(2:, 3:, 42:)
+  ! CHECK: fir.box_addr
+  ! CHECK: fir.box_dim
+  ! CHECK: %[[c2_i64:.*]] = arith.constant 2 : i64
+  ! CHECK: %[[c2:.*]] = fir.convert %[[c2_i64]] : (i64) -> index
+  ! CHECK: fir.box_dim
+  ! CHECK: %[[c3_i64:.*]] = arith.constant 3 : i64
+  ! CHECK: %[[c3:.*]] = fir.convert %[[c3_i64]] : (i64) -> index
+  ! CHECK: fir.box_dim
+  ! CHECK: %[[c42_i64:.*]] = arith.constant 42 : i64
+  ! CHECK: %[[c42:.*]] = fir.convert %[[c42_i64]] : (i64) -> index
+
+  print *, x
+  ! CHECK: fir.shape_shift %[[c2]], %{{.*}}, %[[c3]], %{{.*}}, %[[c42]], %{{.*}} :
+end subroutine
+
+! Constant length
+! func @_QPtest_assumed_shape_char(%arg0: !fir.box<!fir.array<?x!fir.char<1,10>>> {fir.bindc_name = "c", fir.contiguous})
+subroutine test_assumed_shape_char(c)
+  character(10), contiguous :: c(:)
+  ! CHECK: %[[addr:.*]] = fir.box_addr %arg0 : (!fir.box<!fir.array<?x!fir.char<1,10>>>) -> !fir.ref<!fir.array<?x!fir.char<1,10>>>
+
+  ! CHECK: %[[dims:.*]]:3 = fir.box_dims %arg0, %c0 : (!fir.box<!fir.array<?x!fir.char<1,10>>>, index) -> (index, index, index)
+  ! CHECK: %[[c1:.*]] = arith.constant 1 : index
+
+  print *, c
+  ! CHECK: %[[shape:.*]] = fir.shape_shift %[[c1]], %[[dims]]#1 : (index, index) -> !fir.shapeshift<1>
+  ! CHECK: fir.embox %[[addr]](%[[shape]]) : (!fir.ref<!fir.array<?x!fir.char<1,10>>>, !fir.shapeshift<1>) -> !fir.box<!fir.array<?x!fir.char<1,10>>>
+end subroutine
+
+! Assumed length
+! CHECK-LABEL: func @_QPtest_assumed_shape_char_2(%arg0: !fir.box<!fir.array<?x!fir.char<1,?>>> {fir.bindc_name = "c", fir.contiguous})
+subroutine test_assumed_shape_char_2(c)
+  character(*), contiguous :: c(:)
+  ! CHECK: %[[addr:.*]] = fir.box_addr %arg0 : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> !fir.ref<!fir.array<?x!fir.char<1,?>>>
+  ! CHECK: %[[len:.*]] = fir.box_elesize %arg0 : (!fir.box<!fir.array<?x!fir.char<1,?>>>) -> index
+
+  ! CHECK: %[[dims:.*]]:3 = fir.box_dims %arg0, %c0 : (!fir.box<!fir.array<?x!fir.char<1,?>>>, index) -> (index, index, index)
+  ! CHECK: %[[c1:.*]] = arith.constant 1 : index
+
+  print *, c
+  ! CHECK: %[[shape:.*]] = fir.shape_shift %[[c1]], %[[dims]]#1 : (index, index) -> !fir.shapeshift<1>
+  ! CHECK: fir.embox %[[addr]](%[[shape]]) typeparams %[[len]] : (!fir.ref<!fir.array<?x!fir.char<1,?>>>, !fir.shapeshift<1>, index) -> !fir.box<!fir.array<?x!fir.char<1,?>>>
+end subroutine
+
+
+! lower bounds all 1.
+! CHECK: func @_QPtest_assumed_shape_char_3(%arg0: !fir.box<!fir.array<?x?x!fir.char<1,?>>> {fir.bindc_name = "c", fir.contiguous})
+subroutine test_assumed_shape_char_3(c)
+  character(*), contiguous :: c(1:, 1:)
+  ! CHECK: fir.box_addr
+  ! CHECK: fir.box_elesize
+  ! CHECK: %[[dims1:.*]]:3 = fir.box_dims
+  ! CHECK: %[[dims2:.*]]:3 = fir.box_dims
+  print *, c
+  ! CHECK: fir.call @_FortranAioBeginExternalListOutput
+  ! CHECK: fir.shape %[[dims1]]#1, %[[dims2]]#1
+end subroutine

flang/test/Lower/assumed-shape-caller.f90

@@ -0,0 +1,97 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! Test passing arrays to assumed shape dummy arguments
+
+! CHECK-LABEL: func @_QPfoo()
+subroutine foo()
+  interface
+    subroutine bar(x)
+      ! lbounds are meaningless on caller side, some are added
+      ! here to check they are ignored.
+      real :: x(1:, 10:, :)
+    end subroutine
+  end interface
+  real :: x(42, 55, 12)
+  ! CHECK-DAG: %[[c42:.*]] = arith.constant 42 : index
+  ! CHECK-DAG: %[[c55:.*]] = arith.constant 55 : index
+  ! CHECK-DAG: %[[c12:.*]] = arith.constant 12 : index
+  ! CHECK-DAG: %[[addr:.*]] = fir.alloca !fir.array<42x55x12xf32> {{{.*}}uniq_name = "_QFfooEx"}
+
+  call bar(x)
+  ! CHECK: %[[shape:.*]] = fir.shape %[[c42]], %[[c55]], %[[c12]] : (index, index, index) -> !fir.shape<3>
+  ! CHECK: %[[embox:.*]] = fir.embox %[[addr]](%[[shape]]) : (!fir.ref<!fir.array<42x55x12xf32>>, !fir.shape<3>) -> !fir.box<!fir.array<42x55x12xf32>>
+  ! CHECK: %[[castedBox:.*]] = fir.convert %[[embox]] : (!fir.box<!fir.array<42x55x12xf32>>) -> !fir.box<!fir.array<?x?x?xf32>>
+  ! CHECK: fir.call @_QPbar(%[[castedBox]]) : (!fir.box<!fir.array<?x?x?xf32>>) -> ()
+end subroutine
+
+
+! Test passing character array as assumed shape.
+! CHECK-LABEL: func @_QPfoo_char(%arg0: !fir.boxchar<1>{{.*}})
+subroutine foo_char(x)
+  interface
+    subroutine bar_char(x)
+      character(*) :: x(1:, 10:, :)
+    end subroutine
+  end interface
+  character(*) :: x(42, 55, 12)
+  ! CHECK-DAG: %[[x:.*]]:2 = fir.unboxchar %arg0 : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+  ! CHECK-DAG: %[[addr:.*]] = fir.convert %[[x]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.array<42x55x12x!fir.char<1,?>>>
+  ! CHECK-DAG: %[[c42:.*]] = arith.constant 42 : index
+  ! CHECK-DAG: %[[c55:.*]] = arith.constant 55 : index
+  ! CHECK-DAG: %[[c12:.*]] = arith.constant 12 : index
+
+  call bar_char(x)
+  ! CHECK: %[[shape:.*]] = fir.shape %[[c42]], %[[c55]], %[[c12]] : (index, index, index) -> !fir.shape<3>
+  ! CHECK: %[[embox:.*]] = fir.embox %[[addr]](%[[shape]]) typeparams %[[x]]#1 : (!fir.ref<!fir.array<42x55x12x!fir.char<1,?>>>, !fir.shape<3>, index) -> !fir.box<!fir.array<42x55x12x!fir.char<1,?>>>
+  ! CHECK: %[[castedBox:.*]] = fir.convert %[[embox]] : (!fir.box<!fir.array<42x55x12x!fir.char<1,?>>>) -> !fir.box<!fir.array<?x?x?x!fir.char<1,?>>>
+  ! CHECK: fir.call @_QPbar_char(%[[castedBox]]) : (!fir.box<!fir.array<?x?x?x!fir.char<1,?>>>) -> ()
+end subroutine
+
+! CHECK-LABEL: func @_QPtest_vector_subcripted_section_to_box(
+! CHECK-SAME:  %[[VAL_0:.*]]: !fir.box<!fir.array<?xi32>> {fir.bindc_name = "v"},
+! CHECK-SAME:  %[[VAL_1:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x"}) {
+subroutine test_vector_subcripted_section_to_box(v, x)
+  ! Test that a copy is made when passing a vector subscripted variable to
+  ! an assumed shape argument.
+  interface
+    subroutine takes_box(y)
+      real :: y(:)
+    end subroutine
+  end interface
+  integer :: v(:)
+  real :: x(:) 
+  call takes_box(x(v))
+! CHECK:  %[[VAL_2:.*]] = arith.constant 1 : index
+! CHECK:  %[[VAL_3:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_4:.*]]:3 = fir.box_dims %[[VAL_1]], %[[VAL_3]] : (!fir.box<!fir.array<?xf32>>, index) -> (index, index, index)
+! CHECK:  %[[VAL_5:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_6:.*]]:3 = fir.box_dims %[[VAL_0]], %[[VAL_5]] : (!fir.box<!fir.array<?xi32>>, index) -> (index, index, index)
+! CHECK:  %[[VAL_7:.*]] = fir.array_load %[[VAL_0]] : (!fir.box<!fir.array<?xi32>>) -> !fir.array<?xi32>
+! CHECK:  %[[VAL_8:.*]] = arith.cmpi sgt, %[[VAL_6]]#1, %[[VAL_4]]#1 : index
+! CHECK:  %[[VAL_9:.*]] = arith.select %[[VAL_8]], %[[VAL_4]]#1, %[[VAL_6]]#1 : index
+! CHECK:  %[[VAL_10:.*]] = fir.array_load %[[VAL_1]] : (!fir.box<!fir.array<?xf32>>) -> !fir.array<?xf32>
+! CHECK:  %[[VAL_11:.*]] = fir.allocmem !fir.array<?xf32>, %[[VAL_9]] {uniq_name = ".array.expr"}
+! CHECK:  %[[VAL_12:.*]] = fir.shape %[[VAL_9]] : (index) -> !fir.shape<1>
+! CHECK:  %[[VAL_13:.*]] = fir.array_load %[[VAL_11]](%[[VAL_12]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.array<?xf32>
+! CHECK:  %[[VAL_14:.*]] = arith.constant 1 : index
+! CHECK:  %[[VAL_15:.*]] = arith.constant 0 : index
+! CHECK:  %[[VAL_16:.*]] = arith.subi %[[VAL_9]], %[[VAL_14]] : index
+! CHECK:  %[[VAL_17:.*]] = fir.do_loop %[[VAL_18:.*]] = %[[VAL_15]] to %[[VAL_16]] step %[[VAL_14]] unordered iter_args(%[[VAL_19:.*]] = %[[VAL_13]]) -> (!fir.array<?xf32>) {
+! CHECK:    %[[VAL_20:.*]] = fir.array_fetch %[[VAL_7]], %[[VAL_18]] : (!fir.array<?xi32>, index) -> i32
+! CHECK:    %[[VAL_21:.*]] = fir.convert %[[VAL_20]] : (i32) -> index
+! CHECK:    %[[VAL_22:.*]] = arith.subi %[[VAL_21]], %[[VAL_2]] : index
+! CHECK:    %[[VAL_23:.*]] = fir.array_fetch %[[VAL_10]], %[[VAL_22]] : (!fir.array<?xf32>, index) -> f32
+! CHECK:    %[[VAL_24:.*]] = fir.array_update %[[VAL_19]], %[[VAL_23]], %[[VAL_18]] : (!fir.array<?xf32>, f32, index) -> !fir.array<?xf32>
+! CHECK:    fir.result %[[VAL_24]] : !fir.array<?xf32>
+! CHECK:  }
+! CHECK:  fir.array_merge_store %[[VAL_13]], %[[VAL_25:.*]] to %[[VAL_11]] : !fir.array<?xf32>, !fir.array<?xf32>, !fir.heap<!fir.array<?xf32>>
+! CHECK:  %[[VAL_26:.*]] = fir.shape %[[VAL_9]] : (index) -> !fir.shape<1>
+! CHECK:  %[[VAL_27:.*]] = fir.embox %[[VAL_11]](%[[VAL_26]]) : (!fir.heap<!fir.array<?xf32>>, !fir.shape<1>) -> !fir.box<!fir.array<?xf32>>
+! CHECK:  fir.call @_QPtakes_box(%[[VAL_27]]) : (!fir.box<!fir.array<?xf32>>) -> ()
+! CHECK:  fir.freemem %[[VAL_11]]
+end subroutine
+
+! Test external function declarations
+
+! CHECK: func private @_QPbar(!fir.box<!fir.array<?x?x?xf32>>)
+! CHECK: func private @_QPbar_char(!fir.box<!fir.array<?x?x?x!fir.char<1,?>>>)

flang/test/Lower/attributes.f90

@@ -0,0 +1,29 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! Test propagation of Fortran attributes to FIR.
+
+
+! CHECK-LABEL: func @_QPfoo1(
+! CHECK-SAME: %arg0: !fir.ref<f32> {fir.bindc_name = "x", fir.optional},
+! CHECK-SAME: %arg1: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "y", fir.optional},
+! CHECK-SAME: %arg2: !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>> {fir.bindc_name = "i", fir.optional},
+! CHECK-SAME: %arg3: !fir.boxchar<1> {fir.bindc_name = "c", fir.optional}
+subroutine foo1(x, y, i, c)
+  real, optional :: x, y(:)
+  integer, allocatable, optional :: i(:)
+  character, optional :: c
+end subroutine
+
+! CHECK-LABEL: func @_QPfoo2(
+! CHECK-SAME: %arg0: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous},
+! CHECK-SAME: %arg1: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>> {fir.bindc_name = "i", fir.contiguous}
+subroutine foo2(x, i)
+  real, contiguous :: x(:)
+  integer, pointer, contiguous :: i(:)
+end subroutine
+
+! CHECK-LABEL: func @_QPfoo3
+! CHECK-SAME: %arg0: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.contiguous, fir.optional}
+subroutine foo3(x)
+  real, optional, contiguous :: x(:)
+end subroutine