OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.dg/] [intrinsic_ifunction_1.f90] - Blame information for rev 399

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 302 jeremybenn 
! { dg-do run }
2 
! PR 35995 - ifunction.m4 and ifunction_logical.m4 had a bug
3 
! where zero-sized arguments were not handled correctly.
4 
! Test case provided by Dick Hendrickson, amended by
5 
! Thomas Koenig.
6 
 
7 
      program try_gf0026_etc
8 
 
9 
      call       gf0026(  0,  1)
10 
      call       foo   (  0,  1)
11 
 
12 
      end program
13 
 
14 
      SUBROUTINE GF0026(nf0,nf1)
15 
      LOGICAL LDA(9)
16 
      INTEGER IDA(NF0,9), iii(9)
17 
 
18 
      lda = (/ (i/2*2 .eq. I, i=1,9) /)
19 
      LDA = ALL ( IDA .NE. -1000,  1)
20 
      if (.not. all(lda)) call abort
21 
      if (.not. all(ida .ne. -1000)) call abort
22 
 
23 
      lda = (/ (i/2*2 .eq. I, i=1,9) /)
24 
      LDA = any ( IDA .NE. -1000,  1)
25 
      print *, lda          !expect FALSE
26 
      if (any(lda)) call abort
27 
      print *, any(ida .ne. -1000)   !expect FALSE
28 
      if (any(ida .ne. -1000)) call abort
29 
 
30 
      iii = 137
31 
      iii = count ( IDA .NE. -1000,  1)
32 
      if (any(iii /= 0)) call abort
33 
      if (count(ida .ne. -1000) /= 0) call abort
34 
 
35 
      END SUBROUTINE
36 
 
37 
      subroutine foo (nf0, nf1)
38 
      integer, dimension(9):: res, iii
39 
      integer, dimension(nf0,9) :: ida
40 
      res = (/ (-i, i=1,9) /)
41 
      res = product (ida, 1)
42 
      if (any(res /= 1)) call abort
43 
      end subroutine foo

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.