File: intrinsic_ifunction_1.f90

package info (click to toggle)
gcc-arm-none-eabi 15%3A12.2.rel1-1
  • links: PTS, VCS
  • area: main
  • in suites: bookworm
  • size: 959,712 kB
  • sloc: cpp: 3,275,382; ansic: 2,061,766; ada: 840,956; f90: 208,513; makefile: 76,132; asm: 73,433; xml: 50,448; exp: 34,146; sh: 32,436; objc: 15,637; fortran: 14,012; python: 11,991; pascal: 6,787; awk: 4,779; perl: 3,054; yacc: 338; ml: 285; lex: 201; haskell: 122
file content (43 lines) | stat: -rw-r--r-- 1,184 bytes parent folder | download | duplicates (3) 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
 
! { dg-do run }
! PR 35995 - ifunction.m4 and ifunction_logical.m4 had a bug
! where zero-sized arguments were not handled correctly.
! Test case provided by Dick Hendrickson, amended by
! Thomas Koenig.

      program try_gf0026_etc

      call       gf0026(  0,  1)
      call       foo   (  0,  1)

      end program

      SUBROUTINE GF0026(nf0,nf1)
      LOGICAL LDA(9)
      INTEGER IDA(NF0,9), iii(9)

      lda = (/ (i/2*2 .eq. I, i=1,9) /)
      LDA = ALL ( IDA .NE. -1000,  1)
      if (.not. all(lda)) STOP 1
      if (.not. all(ida .ne. -1000)) STOP 2

      lda = (/ (i/2*2 .eq. I, i=1,9) /)
      LDA = any ( IDA .NE. -1000,  1)
      print *, lda          !expect FALSE
      if (any(lda)) STOP 3
      print *, any(ida .ne. -1000)   !expect FALSE
      if (any(ida .ne. -1000)) STOP 4

      iii = 137
      iii = count ( IDA .NE. -1000,  1)
      if (any(iii /= 0)) STOP 5
      if (count(ida .ne. -1000) /= 0) STOP 6

      END SUBROUTINE

      subroutine foo (nf0, nf1)
      integer, dimension(9):: res, iii
      integer, dimension(nf0,9) :: ida
      res = (/ (-i, i=1,9) /)
      res = product (ida, 1)
      if (any(res /= 1)) STOP 7
      end subroutine foo