OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [intrinsic_actual_2.f90] - Blame information for rev 749

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

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do compile }
2
! Tests the fix for PR29387, in which array valued arguments of
3
! LEN and ASSOCIATED would cause an ICE.
4
!
5
! Contributed by Francois-Xavier Coudert  
6
!
7
  integer  :: ans
8
  TYPE T1
9
    INTEGER, POINTER :: I=>NULL()
10
  END TYPE T1
11
  type(T1), pointer :: tar(:)
12
 
13
  character(20) res
14
 
15
  j = 10
16
  PRINT *, LEN(SUB(8)), ans
17
  PRINT *, LEN(SUB(j)), ans
18
!  print *, len(SUB(j + 2)//"a"), ans   ! This still fails (no charlen).
19
  print *, len(bar(2)), ans
20
 
21
  IF(.NOT.ASSOCIATED(F1(10))) CALL ABORT()
22
  deallocate (tar)
23
 
24
CONTAINS
25
 
26
  FUNCTION SUB(I)
27
    CHARACTER(LEN=I) :: SUB(1)
28
    ans = LEN(SUB(1))
29
    SUB = ""
30
  END FUNCTION
31
 
32
  FUNCTION BAR(I)
33
    CHARACTER(LEN=I*10) :: BAR(1)
34
    ans = LEN(BAR)
35
    BAR = ""
36
  END FUNCTION
37
 
38
  FUNCTION F1(I) RESULT(R)
39
   TYPE(T1), DIMENSION(:), POINTER :: R
40
   INTEGER :: I
41
   ALLOCATE(tar(I))
42
   R => tar
43
  END FUNCTION F1
44
END

powered by: WebSVN 2.1.0

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