diff options
Diffstat (limited to 'flang/test/Semantics')
33 files changed, 441 insertions, 45 deletions
diff --git a/flang/test/Semantics/OpenACC/acc-parallel.f90 b/flang/test/Semantics/OpenACC/acc-parallel.f90 index 635c547f744c..45c0fafbed1b 100644 --- a/flang/test/Semantics/OpenACC/acc-parallel.f90 +++ b/flang/test/Semantics/OpenACC/acc-parallel.f90 @@ -200,3 +200,25 @@ program openacc_parallel_validity !$acc end parallel end program openacc_parallel_validity + +subroutine acc_parallel_default_none + integer :: i, l + real :: a(10,10) + l = 10 + !$acc parallel default(none) + !$acc loop + !ERROR: The DEFAULT(NONE) clause requires that 'l' must be listed in a data-mapping clause + do i = 1, l + !ERROR: The DEFAULT(NONE) clause requires that 'a' must be listed in a data-mapping clause + a(1,i) = 1 + end do + !$acc end parallel + + !$acc data copy(a) + !$acc parallel loop firstprivate(l) default(none) + do i = 1, l + a(1,i) = 1 + end do + !$acc end parallel + !$acc end data +end subroutine acc_parallel_default_none diff --git a/flang/test/Semantics/OpenACC/acc-reduction-validity.f90 b/flang/test/Semantics/OpenACC/acc-reduction-validity.f90 index 0cdf33a2adb9..fd83e411191d 100644 --- a/flang/test/Semantics/OpenACC/acc-reduction-validity.f90 +++ b/flang/test/Semantics/OpenACC/acc-reduction-validity.f90 @@ -177,13 +177,23 @@ program openacc_reduction_validity end program subroutine sum() - ! ERROR: 'sum' is already declared in this scoping unit + !ERROR: 'sum' is already declared in this scoping unit integer :: i,sum sum = 0 - !$acc parallel + !$acc parallel + !ERROR: Only variables are allowed in data clauses on the LOOP directive !$acc loop independent gang reduction(+:sum) do i=1,10 sum = sum + i enddo !$acc end parallel end subroutine + +subroutine reduce() + integer :: red = 0, ii + !$acc parallel loop default(none) reduction(+:red) + do ii = 1, 10 + red = red + ii + end do + !$acc end parallel +end subroutine diff --git a/flang/test/Semantics/OpenMP/declare-mapper02.f90 b/flang/test/Semantics/OpenMP/declare-mapper02.f90 index a62a7f8d0a39..2ad87c914bc7 100644 --- a/flang/test/Semantics/OpenMP/declare-mapper02.f90 +++ b/flang/test/Semantics/OpenMP/declare-mapper02.f90 @@ -6,5 +6,6 @@ type, abstract :: t1 end type t1 !ERROR: ABSTRACT derived type may not be used here +!ERROR: Reference to object with abstract derived type 't1' must be polymorphic !$omp declare mapper(mm : t1::x) map(x, x%y) end diff --git a/flang/test/Semantics/OpenMP/depend01.f90 b/flang/test/Semantics/OpenMP/depend01.f90 index 19fcfbf64beb..6c6cc16bcc5f 100644 --- a/flang/test/Semantics/OpenMP/depend01.f90 +++ b/flang/test/Semantics/OpenMP/depend01.f90 @@ -20,7 +20,7 @@ program omp_depend !ERROR: 'a' in DEPEND clause must have a positive stride !ERROR: 'b' in DEPEND clause must have a positive stride !ERROR: 'b' in DEPEND clause is a zero size array section - !$omp task shared(x) depend(in: a(10:5:-1)) depend(in: b(5:10:-1)) + !$omp task shared(x) depend(in: a(10:5:-1)) depend(in: b(5:10:-1, 2)) print *, a(5:10), b !$omp end task diff --git a/flang/test/Semantics/OpenMP/depend07.f90 b/flang/test/Semantics/OpenMP/depend07.f90 new file mode 100644 index 000000000000..53c98b079f34 --- /dev/null +++ b/flang/test/Semantics/OpenMP/depend07.f90 @@ -0,0 +1,11 @@ +!RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=45 + +subroutine foo(x) + integer :: x(3, *) + !$omp task depend(in:x(:,5)) + !$omp end task + !ERROR: Assumed-size array 'x' must have explicit final subscript upper bound value + !$omp task depend(in:x(5,:)) + !$omp end task +end + diff --git a/flang/test/Semantics/OpenMP/do-collapse.f90 b/flang/test/Semantics/OpenMP/do-collapse.f90 index 480bd45b79b8..ec6a3bdad368 100644 --- a/flang/test/Semantics/OpenMP/do-collapse.f90 +++ b/flang/test/Semantics/OpenMP/do-collapse.f90 @@ -31,6 +31,7 @@ program omp_doCollapse end do end do + !ERROR: The value of the parameter in the COLLAPSE or ORDERED clause must not be larger than the number of nested loops following the construct. !ERROR: At most one COLLAPSE clause can appear on the SIMD directive !$omp simd collapse(2) collapse(1) do i = 1, 4 diff --git a/flang/test/Semantics/OpenMP/do-concurrent-collapse.f90 b/flang/test/Semantics/OpenMP/do-concurrent-collapse.f90 index bb1929249183..355626f6e73b 100644 --- a/flang/test/Semantics/OpenMP/do-concurrent-collapse.f90 +++ b/flang/test/Semantics/OpenMP/do-concurrent-collapse.f90 @@ -1,6 +1,7 @@ !RUN: %python %S/../test_errors.py %s %flang -fopenmp integer :: i, j +! ERROR: DO CONCURRENT loops cannot be used with the COLLAPSE clause. !$omp parallel do collapse(2) do i = 1, 1 ! ERROR: DO CONCURRENT loops cannot form part of a loop nest. diff --git a/flang/test/Semantics/OpenMP/do07.f90 b/flang/test/Semantics/OpenMP/do07.f90 index 44fe5f86045a..5b3eb28c17e7 100644 --- a/flang/test/Semantics/OpenMP/do07.f90 +++ b/flang/test/Semantics/OpenMP/do07.f90 @@ -1,5 +1,4 @@ ! RUN: not %flang -fsyntax-only -fopenmp %s 2>&1 | FileCheck %s -! REQUIRES: shell ! OpenMP Version 4.5 ! 2.7.1 Loop Construct ! No statement in the associated loops other than the DO statements diff --git a/flang/test/Semantics/OpenMP/invalid-branch.f90 b/flang/test/Semantics/OpenMP/invalid-branch.f90 index 28aab8b122f3..581103d927bf 100644 --- a/flang/test/Semantics/OpenMP/invalid-branch.f90 +++ b/flang/test/Semantics/OpenMP/invalid-branch.f90 @@ -1,5 +1,4 @@ ! RUN: not %flang -fsyntax-only -fopenmp %s 2>&1 | FileCheck %s -! REQUIRES: shell ! OpenMP Version 4.5 ! Check invalid branches into or out of OpenMP structured blocks. diff --git a/flang/test/Semantics/OpenMP/missing-end-directive.f90 b/flang/test/Semantics/OpenMP/missing-end-directive.f90 new file mode 100644 index 000000000000..6068740999ed --- /dev/null +++ b/flang/test/Semantics/OpenMP/missing-end-directive.f90 @@ -0,0 +1,17 @@ +! RUN: %python %S/../test_errors.py %s %flang -fopenmp + +! Test that we can diagnose missing end directives without an explosion of errors + +! ERROR: Expected OpenMP END PARALLEL directive +!$omp parallel +! ERROR: Expected OpenMP END TASK directive +!$omp task +! ERROR: Expected OpenMP END SECTIONS directive +!$omp sections +! ERROR: Expected OpenMP END PARALLEL directive +!$omp parallel +! ERROR: Expected OpenMP END TASK directive +!$omp task +! ERROR: Expected OpenMP END SECTIONS directive +!$omp sections +end diff --git a/flang/test/Semantics/OpenMP/nontemporal.f90 b/flang/test/Semantics/OpenMP/nontemporal.f90 index ad0ebc85b5ce..ac662bf28df0 100644 --- a/flang/test/Semantics/OpenMP/nontemporal.f90 +++ b/flang/test/Semantics/OpenMP/nontemporal.f90 @@ -1,5 +1,4 @@ ! RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=50 -! REQUIRES: shell ! Check OpenMP clause validity for NONTEMPORAL clause program omp_simd diff --git a/flang/test/Semantics/OpenMP/ordered01.f90 b/flang/test/Semantics/OpenMP/ordered01.f90 index 12543acb2916..75968a6f5ee4 100644 --- a/flang/test/Semantics/OpenMP/ordered01.f90 +++ b/flang/test/Semantics/OpenMP/ordered01.f90 @@ -52,27 +52,14 @@ program main end do !$omp end do - !$omp do ordered(1) - do i = 2, N - !ERROR: DEPEND clauses are not allowed when ORDERED construct is a block construct with an ORDERED region - !$omp ordered depend(source) - arrayA(i) = foo(i) - !$omp end ordered - !ERROR: DEPEND clauses are not allowed when ORDERED construct is a block construct with an ORDERED region - !$omp ordered depend(sink: i - 1) - arrayB(i) = bar(arrayA(i), arrayB(i-1)) - !$omp end ordered - end do - !$omp end do - contains subroutine work1() - !ERROR: THREADS and SIMD clauses are not allowed when ORDERED construct is a standalone construct with no ORDERED region + !ERROR: Expected OpenMP END ORDERED directive !$omp ordered simd end subroutine work1 subroutine work2() - !ERROR: THREADS and SIMD clauses are not allowed when ORDERED construct is a standalone construct with no ORDERED region + !ERROR: Expected OpenMP END ORDERED directive !$omp ordered threads end subroutine work2 diff --git a/flang/test/Semantics/OpenMP/simd-aligned.f90 b/flang/test/Semantics/OpenMP/simd-aligned.f90 index 0a9f95833e22..4c410a7c4631 100644 --- a/flang/test/Semantics/OpenMP/simd-aligned.f90 +++ b/flang/test/Semantics/OpenMP/simd-aligned.f90 @@ -60,9 +60,16 @@ program omp_simd !$omp end simd !ERROR: 'd' in ALIGNED clause must be of type C_PTR, POINTER or ALLOCATABLE + !WARNING: Alignment is not a power of 2, Aligned clause will be ignored [-Wopen-mp-usage] !$omp simd aligned(d:100) do i = 1, 100 d(i) = i end do + !WARNING: Alignment is not a power of 2, Aligned clause will be ignored [-Wopen-mp-usage] + !$omp simd aligned(b:65) + do i = 1, 100 + b(i) = i + end do + end program omp_simd diff --git a/flang/test/Semantics/OpenMP/simd-only.f90 b/flang/test/Semantics/OpenMP/simd-only.f90 index da42b10d73be..33ab3d62c98e 100644 --- a/flang/test/Semantics/OpenMP/simd-only.f90 +++ b/flang/test/Semantics/OpenMP/simd-only.f90 @@ -131,7 +131,7 @@ end subroutine ! CHECK-LABEL: Name = 'test_target_data' subroutine test_target_data() - ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPBlockConstruct + ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpBlockConstruct ! CHECK-NOT: OmpLoopDirective -> llvm::omp::Directive = target data ! CHECK: ExecutionPartConstruct -> ExecutableConstruct -> DoConstruct !$omp target data map(to: A) map(tofrom: B) @@ -174,7 +174,7 @@ subroutine test_do_ordered() ! CHECK: ExecutionPartConstruct -> ExecutableConstruct -> DoConstruct !$omp do ordered do i = 1, 100 - ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPBlockConstruct + ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpBlockConstruct ! CHECK-NOT: OmpLoopDirective -> llvm::omp::Directive = ordered !$omp ordered x = x + 1 @@ -224,7 +224,7 @@ end subroutine subroutine test_target_map() integer :: array(10) - ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPBlockConstruct + ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpBlockConstruct ! CHECK-NOT: OmpLoopDirective -> llvm::omp::Directive = target !$omp target map(tofrom: array(2:10)) array(2) = array(2) * 2 @@ -288,15 +288,15 @@ end subroutine ! CHECK-LABEL: Name = 'test_task_single_taskwait' subroutine test_task_single_taskwait() integer :: x - ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPBlockConstruct + ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpBlockConstruct ! CHECK-NOT: OmpDirectiveName -> llvm::omp::Directive = parallel !$omp parallel - ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPBlockConstruct + ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpBlockConstruct ! CHECK-NOT: OmpDirectiveName -> llvm::omp::Directive = single !$omp single ! CHECK: ExecutionPartConstruct -> ExecutableConstruct -> DoConstruct do i = 1, 5 - ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPBlockConstruct + ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpBlockConstruct ! CHECK-NOT: OmpDirectiveName -> llvm::omp::Directive = task ! CHECK: ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AssignmentStmt = 'x=i' !$omp task @@ -313,16 +313,16 @@ end subroutine ! CHECK-LABEL: Name = 'test_task_taskyield_flush_barrier' subroutine test_task_taskyield_flush_barrier() integer :: x, i - ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPBlockConstruct + ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpBlockConstruct ! CHECK-NOT: OmpDirectiveName -> llvm::omp::Directive = parallel !$omp parallel ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPStandaloneConstruct -> OpenMPSimpleStandaloneConstruct -> OmpDirectiveSpecification ! CHECK-NOT: OmpDirectiveName -> llvm::omp::Directive = barrier !$omp barrier - ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPBlockConstruct + ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpBlockConstruct ! CHECK-NOT: OmpDirectiveName -> llvm::omp::Directive = single !$omp single - ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPBlockConstruct + ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpBlockConstruct ! CHECK-NOT: OmpDirectiveName -> llvm::omp::Directive = task !$omp task ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPStandaloneConstruct -> OpenMPSimpleStandaloneConstruct -> OmpDirectiveSpecification @@ -333,7 +333,7 @@ subroutine test_task_taskyield_flush_barrier() ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPStandaloneConstruct -> OpenMPFlushConstruct -> OmpDirectiveSpecification !$omp flush !$omp end task - ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPBlockConstruct + ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpBlockConstruct ! CHECK-NOT: OmpDirectiveName -> llvm::omp::Directive = task !$omp task ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPStandaloneConstruct -> OpenMPFlushConstruct -> OmpDirectiveSpecification @@ -348,16 +348,16 @@ end subroutine ! CHECK-LABEL: Name = 'test_master_masked' subroutine test_master_masked() - ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPBlockConstruct + ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpBlockConstruct ! CHECK-NOT: OmpDirectiveName -> llvm::omp::Directive = parallel !$omp parallel private(tid) - ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPBlockConstruct + ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpBlockConstruct ! CHECK-NOT: OmpDirectiveName -> llvm::omp::Directive = masked !$omp masked ! CHECK: ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AssignmentStmt = 'x=y' x = y !$omp end masked - ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPBlockConstruct + ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpBlockConstruct ! CHECK-NOT: OmpDirectiveName -> llvm::omp::Directive = master !$omp master ! CHECK: ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AssignmentStmt = 'y=x' @@ -368,7 +368,7 @@ end subroutine ! CHECK-LABEL: Name = 'test_critical' subroutine test_critical() - ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPBlockConstruct + ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpBlockConstruct ! CHECK-NOT: OmpDirectiveName -> llvm::omp::Directive = parallel !$omp parallel do private(i) do i = 1, 4 @@ -385,7 +385,7 @@ subroutine test_target_enter_exit_update_data() ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPStandaloneConstruct -> OpenMPSimpleStandaloneConstruct -> OmpDirectiveSpecification ! CHECK-NOT: OmpDirectiveName -> llvm::omp::Directive = target enter data !$omp target enter data map(to: A) - ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OpenMPBlockConstruct + ! CHECK-NOT: ExecutionPartConstruct -> ExecutableConstruct -> OpenMPConstruct -> OmpBlockConstruct ! CHECK-NOT: OmpDirectiveName -> llvm::omp::Directive = target teams distribute parallel do !$omp target teams distribute parallel do ! CHECK: ExecutionPartConstruct -> ExecutableConstruct -> DoConstruct diff --git a/flang/test/Semantics/OpenMP/workdistribute01.f90 b/flang/test/Semantics/OpenMP/workdistribute01.f90 new file mode 100644 index 000000000000..f7e36976dfb6 --- /dev/null +++ b/flang/test/Semantics/OpenMP/workdistribute01.f90 @@ -0,0 +1,16 @@ +! RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=60 +! OpenMP Version 6.0 +! workdistribute Construct +! Invalid do construct inside !$omp workdistribute + +subroutine workdistribute() + integer n, i + !ERROR: A WORKDISTRIBUTE region must be nested inside TEAMS region only. + !ERROR: The structured block in a WORKDISTRIBUTE construct may consist of only SCALAR or ARRAY assignments + !$omp workdistribute + do i = 1, n + print *, "omp workdistribute" + end do + !$omp end workdistribute + +end subroutine workdistribute diff --git a/flang/test/Semantics/OpenMP/workdistribute02.f90 b/flang/test/Semantics/OpenMP/workdistribute02.f90 new file mode 100644 index 000000000000..6de3a55f545b --- /dev/null +++ b/flang/test/Semantics/OpenMP/workdistribute02.f90 @@ -0,0 +1,34 @@ +! RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=60 +! OpenMP Version 6.0 +! workdistribute Construct +! The !omp workdistribute construct must not contain any user defined +! function calls unless the function is ELEMENTAL. + +module my_mod + contains + integer function my_func() + my_func = 10 + end function my_func + + impure integer function impure_my_func() + impure_my_func = 20 + end function impure_my_func + + impure elemental integer function impure_ele_my_func() + impure_ele_my_func = 20 + end function impure_ele_my_func +end module my_mod + +subroutine workdistribute(aa, bb, cc, n) + use my_mod + integer n + real aa(n), bb(n), cc(n) + !$omp teams + !$omp workdistribute + !ERROR: User defined non-ELEMENTAL function 'my_func' is not allowed in a WORKDISTRIBUTE construct + aa = my_func() + aa = bb * cc + !$omp end workdistribute + !$omp end teams + +end subroutine workdistribute diff --git a/flang/test/Semantics/OpenMP/workdistribute03.f90 b/flang/test/Semantics/OpenMP/workdistribute03.f90 new file mode 100644 index 000000000000..828170a016ed --- /dev/null +++ b/flang/test/Semantics/OpenMP/workdistribute03.f90 @@ -0,0 +1,34 @@ +! RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=60 +! OpenMP Version 6.0 +! workdistribute Construct +! All array assignments, scalar assignments, and masked array assignments +! must be intrinsic assignments. + +module defined_assign + interface assignment(=) + module procedure work_assign + end interface + + contains + subroutine work_assign(a,b) + integer, intent(out) :: a + logical, intent(in) :: b(:) + end subroutine work_assign +end module defined_assign + +program omp_workdistribute + use defined_assign + + integer :: a, aa(10), bb(10) + logical :: l(10) + l = .TRUE. + + !$omp teams + !$omp workdistribute + !ERROR: Defined assignment statement is not allowed in a WORKDISTRIBUTE construct + a = l + aa = bb + !$omp end workdistribute + !$omp end teams + +end program omp_workdistribute diff --git a/flang/test/Semantics/OpenMP/workdistribute04.f90 b/flang/test/Semantics/OpenMP/workdistribute04.f90 new file mode 100644 index 000000000000..d407e8a073ae --- /dev/null +++ b/flang/test/Semantics/OpenMP/workdistribute04.f90 @@ -0,0 +1,15 @@ +! RUN: %python %S/../test_errors.py %s %flang -fopenmp -fopenmp-version=50 +! OpenMP Version 6.0 +! workdistribute Construct +! Unsuported OpenMP version + +subroutine teams_workdistribute() + use iso_fortran_env + real(kind=real32) :: a + real(kind=real32), dimension(10) :: x + real(kind=real32), dimension(10) :: y + !ERROR: WORKDISTRIBUTE construct is not allowed in OpenMP v5.0, try -fopenmp-version=60 + !$omp teams workdistribute + y = a * x + y + !$omp end teams workdistribute +end subroutine teams_workdistribute diff --git a/flang/test/Semantics/bind-c01.f90 b/flang/test/Semantics/bind-c01.f90 index f0546b3eb068..79d53677abc9 100644 --- a/flang/test/Semantics/bind-c01.f90 +++ b/flang/test/Semantics/bind-c01.f90 @@ -29,3 +29,11 @@ subroutine foo() bind(c, name="x6") end subroutine subroutine foo() bind(c, name="x7") end subroutine + +subroutine entries() + +entry e1() bind(C, name="e") + +!ERROR: Two entities have the same global name 'e' +entry e2() bind(C, name="e") +end subroutine diff --git a/flang/test/Semantics/c_loc01.f90 b/flang/test/Semantics/c_loc01.f90 index da8a0e5bdd9e..16f5618b6330 100644 --- a/flang/test/Semantics/c_loc01.f90 +++ b/flang/test/Semantics/c_loc01.f90 @@ -66,3 +66,12 @@ module m purefun2 = 1 end end module + +module m2 + use iso_c_binding + ! In this context (structure constructor from intrinsic module being used directly + ! in another module), emit only a warning, since this module might have originally + ! been a module file that was converted back into Fortran. + !WARNING: PRIVATE name '__address' is accessible only within module '__fortran_builtins' + type(c_ptr) :: p = c_ptr(0) +end diff --git a/flang/test/Semantics/call45.f90 b/flang/test/Semantics/call45.f90 new file mode 100644 index 000000000000..056ce4718916 --- /dev/null +++ b/flang/test/Semantics/call45.f90 @@ -0,0 +1,41 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic -Werror +program call45 + integer, target :: v(100) = [(i, i=1, 100)] + integer, pointer :: p(:) => v + !ERROR: Actual argument associated with VOLATILE dummy argument 'v=' is not definable [-Wundefinable-asynchronous-or-volatile-actual] + !BECAUSE: Variable 'v([INTEGER(8)::1_8,2_8,2_8,3_8,3_8,3_8,4_8,4_8,4_8,4_8])' has a vector subscript + call sub(v([1,2,2,3,3,3,4,4,4,4])) + !PORTABILITY: The array section 'v(21_8:30_8:1_8)' should not be associated with dummy argument 'v=' with VOLATILE attribute, unless the dummy is assumed-shape or assumed-rank [-Wportability] + call sub(v(21:30)) + !PORTABILITY: The array section 'v(21_8:40_8:2_8)' should not be associated with dummy argument 'v=' with VOLATILE attribute, unless the dummy is assumed-shape or assumed-rank [-Wportability] + call sub(v(21:40:2)) + call sub2(v(21:40:2)) + call sub4(p) + print *, v +contains + subroutine sub(v) + integer, volatile :: v(10) + v = 0 + end subroutine sub + subroutine sub1(v) + integer, volatile :: v(:) + v = 0 + end subroutine sub1 + subroutine sub2(v) + integer :: v(:) + !TODO: This should either be an portability warning or copy-in-copy-out warning + call sub(v) + call sub1(v) + end subroutine sub2 + subroutine sub3(v) + integer, pointer :: v(:) + v = 0 + end subroutine sub3 + subroutine sub4(v) + integer, pointer :: v(:) + !TODO: This should either be a portability warning or copy-in-copy-out warning + call sub(v) + call sub1(v) + call sub3(v) + end subroutine sub4 +end program call45 diff --git a/flang/test/Semantics/contiguous02.f90 b/flang/test/Semantics/contiguous02.f90 new file mode 100644 index 000000000000..6543ea92b940 --- /dev/null +++ b/flang/test/Semantics/contiguous02.f90 @@ -0,0 +1,27 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic +subroutine s1 + type :: d1 + real :: x + end type + type :: d2 + type(d1) :: x + end type + type(d1), target :: a(5) + type(d2), target :: b(5) + real, pointer, contiguous :: c(:) + c => a%x ! okay, type has single component + c => b%x%x ! okay, types have single components +end + +subroutine s2 + type :: d1 + real :: x, y + end type + type(d1), target :: b(5) + real, pointer, contiguous :: c(:) + !ERROR: CONTIGUOUS pointer may not be associated with a discontiguous target + c => b%x + c => b(1:1)%x ! okay, one element + !ERROR: CONTIGUOUS pointer may not be associated with a discontiguous target + c => b(1:2)%x +end diff --git a/flang/test/Semantics/cuf-device-procedures01.cuf b/flang/test/Semantics/cuf-device-procedures01.cuf index 92ee02bb3c64..d8883860f46b 100644 --- a/flang/test/Semantics/cuf-device-procedures01.cuf +++ b/flang/test/Semantics/cuf-device-procedures01.cuf @@ -40,5 +40,5 @@ subroutine host() end subroutine ! CHECK-LABEL: Subprogram scope: host -! CHECK: atomicadd, EXTERNAL: HostAssoc{{$}} -! CHECK: syncthreads, EXTERNAL: HostAssoc{{$}} +! CHECK: atomicadd, EXTERNAL: HostAssoc => atomicadd, EXTERNAL (Function, Implicit): ProcEntity REAL(4){{$}} +! CHECK: syncthreads, EXTERNAL: HostAssoc => syncthreads, EXTERNAL (Subroutine): ProcEntity{{$}} diff --git a/flang/test/Semantics/global02.f90 b/flang/test/Semantics/global02.f90 new file mode 100644 index 000000000000..505b3b06b137 --- /dev/null +++ b/flang/test/Semantics/global02.f90 @@ -0,0 +1,37 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror +! Catch discrepancies between implicit result types and a global definition + +complex function zbefore() +zbefore = (0.,0.) +end + +program main +!ERROR: Implicit declaration of function 'zbefore' has a different result type than in previous declaration +print *, zbefore() +print *, zafter() +print *, zafter2() +print *, zafter3() +end + +subroutine another +implicit integer(z) +!ERROR: Implicit declaration of function 'zafter' has a different result type than in previous declaration +print *, zafter() +end + +!ERROR: Function 'zafter' has a result type that differs from the implicit type it obtained in a previous reference +complex function zafter() +zafter = (0.,0.) +end + +function zafter2() +!ERROR: Function 'zafter2' has a result type that differs from the implicit type it obtained in a previous reference +complex zafter2 +zafter2 = (0.,0.) +end + +function zafter3() result(res) +!ERROR: Function 'zafter3' has a result type that differs from the implicit type it obtained in a previous reference +complex res +res = (0.,0.) +end diff --git a/flang/test/Semantics/global03.f90 b/flang/test/Semantics/global03.f90 new file mode 100644 index 000000000000..f9da150d59c7 --- /dev/null +++ b/flang/test/Semantics/global03.f90 @@ -0,0 +1,73 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror +! Catch discrepancies between implicit result types and a global definition, +! allowing for derived types and type equivalence. + +module m + type t1 + integer n + end type + type t2 + real a + end type + type t3 + sequence + integer n + end type +end + +function xfunc1() + use m + type(t1) xfunc1 + xfunc1%n = 123 +end + +function yfunc1() + use m + type(t1) yfunc1 + yfunc1%n = 123 +end + +function zfunc1() + type t3 + sequence + integer n + end type + type(t3) zfunc1 + zfunc1%n = 123 +end + +program main + use m + implicit type(t1) (x) + implicit type(t2) (y) + implicit type(t3) (z) + print *, xfunc1() ! ok + print *, xfunc2() ! ok +!ERROR: Implicit declaration of function 'yfunc1' has a different result type than in previous declaration + print *, yfunc1() + print *, yfunc2() + print *, zfunc1() ! ok + print *, zfunc2() ! ok +end + +function xfunc2() + use m + type(t1) xfunc2 + xfunc2%n = 123 +end + +function yfunc2() + use m +!ERROR: Function 'yfunc2' has a result type that differs from the implicit type it obtained in a previous reference + type(t1) yfunc2 + yfunc2%n = 123 +end + +function zfunc2() + type t3 + sequence + integer n + end type + type(t3) zfunc2 + zfunc2%n = 123 +end diff --git a/flang/test/Semantics/intrinsics03.f90 b/flang/test/Semantics/intrinsics03.f90 index 03109bc300ca..a5b13b655cf4 100644 --- a/flang/test/Semantics/intrinsics03.f90 +++ b/flang/test/Semantics/intrinsics03.f90 @@ -123,3 +123,12 @@ program test call s4(index3) call s4(index4) ! ok end + +subroutine ichar_tests() + integer, parameter :: a1 = ichar('B') + !Without -Wportability, the warning isn't emitted and the parameter is constant. + integer, parameter :: a2 = ichar('B ') + !ERROR: Character in intrinsic function ichar must have length one + !ERROR: Must be a constant value + integer, parameter :: a3 = ichar('') +end subroutine diff --git a/flang/test/Semantics/intrinsics04.f90 b/flang/test/Semantics/intrinsics04.f90 index a7d646e5c016..abb8fe321a57 100644 --- a/flang/test/Semantics/intrinsics04.f90 +++ b/flang/test/Semantics/intrinsics04.f90 @@ -1,4 +1,4 @@ -! RUN: %python %S/test_errors.py %s %flang_fc1 +! RUN: %python %S/test_errors.py %s %flang_fc1 -Wportability ! A potentially absent actual argument cannot require data type conversion. subroutine s(o,a,p) integer(2), intent(in), optional :: o @@ -23,3 +23,12 @@ subroutine s(o,a,p) print *, min(1_2, 2_2, a) ! ok print *, min(1_2, 2_2, p) ! ok end + +subroutine ichar_tests() + integer, parameter :: a1 = ichar('B') + !WARNING: Character in intrinsic function ichar should have length one [-Wportability] + integer, parameter :: a2 = ichar('B ') + !ERROR: Character in intrinsic function ichar must have length one + !ERROR: Must be a constant value + integer, parameter :: a3 = ichar('') +end subroutine diff --git a/flang/test/Semantics/missing_newline.f90 b/flang/test/Semantics/missing_newline.f90 index 7261ac824bed..8e3ff27219cc 100644 --- a/flang/test/Semantics/missing_newline.f90 +++ b/flang/test/Semantics/missing_newline.f90 @@ -1,5 +1,4 @@ ! RUN: echo -n "end program" > %t.f90 ! RUN: %flang_fc1 -fsyntax-only %t.f90 -! RUN: echo -ne "\rend program" > %t.f90 +! RUN: echo -n -e "\rend program" > %t.f90 ! RUN: %flang_fc1 -fsyntax-only %t.f90 -! REQUIRES: shell diff --git a/flang/test/Semantics/offsets05.f90 b/flang/test/Semantics/offsets05.f90 new file mode 100644 index 000000000000..d88fe788576f --- /dev/null +++ b/flang/test/Semantics/offsets05.f90 @@ -0,0 +1,20 @@ +!RUN: %flang_fc1 -fdebug-dump-symbols -fopenmp %s | FileCheck %s + +subroutine sub + common /block/ a + equivalence (b,c), (d,e), (a,f) +!$omp parallel firstprivate(/block/) +!$omp end parallel +end subroutine + +!CHECK: a (Implicit, InCommonBlock) size=4 offset=0: ObjectEntity type: REAL(4) +!CHECK: b (Implicit) size=4 offset=0: ObjectEntity type: REAL(4) +!CHECK: c (Implicit) size=4 offset=0: ObjectEntity type: REAL(4) +!CHECK: d (Implicit) size=4 offset=4: ObjectEntity type: REAL(4) +!CHECK: e (Implicit) size=4 offset=4: ObjectEntity type: REAL(4) +!CHECK: f (Implicit) size=4 offset=0: ObjectEntity type: REAL(4) +!CHECK: sub (Subroutine): HostAssoc => sub (Subroutine): Subprogram () +!CHECK: Equivalence Sets: (b,c) (d,e) (a,f) +!CHECK: block size=4 offset=0: CommonBlockDetails alignment=4: a +!CHECK: OtherConstruct scope: +!CHECK: a (OmpFirstPrivate, OmpExplicit): HostAssoc => a (Implicit, InCommonBlock) size=4 offset=0: ObjectEntity type: REAL(4) diff --git a/flang/test/Semantics/reduce01.f90 b/flang/test/Semantics/reduce01.f90 index ad63a42d73ca..3384366db812 100644 --- a/flang/test/Semantics/reduce01.f90 +++ b/flang/test/Semantics/reduce01.f90 @@ -71,6 +71,8 @@ module m type(pdt(max(x%len, y%len))) :: res res%ch = x%ch // y%ch end function + subroutine bad_reduce + end subroutine subroutine errors real :: a(10,10), b, c(10) @@ -115,6 +117,8 @@ module m !ERROR: MASK= has no .TRUE. element, so IDENTITY= must be present b = reduce(a, f, reshape([(j > 100, j=1, 100)], shape(a))) b = reduce(a, f, reshape([(j == 50, j=1, 100)], shape(a))) ! ok + !ERROR: OPERATION= argument of REDUCE() must be a pure function of two data arguments + b = reduce(a, bad_reduce) end subroutine subroutine not_errors type(pdt(10)) :: a(10), b diff --git a/flang/test/Semantics/resolve20.f90 b/flang/test/Semantics/resolve20.f90 index 8b8d19020668..f1a1a30cc714 100644 --- a/flang/test/Semantics/resolve20.f90 +++ b/flang/test/Semantics/resolve20.f90 @@ -89,4 +89,12 @@ contains !ERROR: Abstract procedure interface 'f' may not be referenced x = f() end subroutine + subroutine baz(foo) + external foo + interface + !WARNING: Dummy argument 'foo' was declared earlier as EXTERNAL [-Wredundant-attribute] + subroutine foo(x) + end + end interface + end end module diff --git a/flang/test/Semantics/spec-expr.f90 b/flang/test/Semantics/spec-expr.f90 index 4d79f2ca188f..f18638c7e9b5 100644 --- a/flang/test/Semantics/spec-expr.f90 +++ b/flang/test/Semantics/spec-expr.f90 @@ -29,14 +29,14 @@ subroutine s2(inArg, inoutArg, outArg, optArg) outArg = 3 block - !PORTABILITY: specification expression refers to host-associated INTENT(OUT) dummy argument 'outarg' + !PORTABILITY: specification expression refers to host-associated INTENT(OUT) dummy argument 'outarg' [-Whost-associated-intent-out-in-spec-expr] real a(outArg) !ERROR: Invalid specification expression: reference to OPTIONAL dummy argument 'optarg' real b(optArg) end block contains subroutine s2inner - !PORTABILITY: specification expression refers to host-associated INTENT(OUT) dummy argument 'outarg' + !PORTABILITY: specification expression refers to host-associated INTENT(OUT) dummy argument 'outarg' [-Whost-associated-intent-out-in-spec-expr] real a(outArg) !ERROR: Invalid specification expression: reference to OPTIONAL dummy argument 'optarg' real b(optArg) diff --git a/flang/test/Semantics/unsigned-errors.f90 b/flang/test/Semantics/unsigned-errors.f90 index 2e2539b40e5e..18f28f21ef8a 100644 --- a/flang/test/Semantics/unsigned-errors.f90 +++ b/flang/test/Semantics/unsigned-errors.f90 @@ -20,8 +20,7 @@ print *, 0u + 1u ! ok print *, 0u - 1u ! ok print *, 0u * 1u ! ok print *, 0u / 1u ! ok -!ERROR: Operands must not be UNSIGNED -print *, 0u ** 1u +print *, 0u ** 1u ! ok print *, uint((0.,0.)) ! ok print *, uint(z'123') ! ok |