1! { dg-do run }
2! Test the fix for PR31293.
3!
4! File: interface4.f90
5! http://home.comcast.net/%7Ekmbtib/Fortran_stuff/interface4.f90
6! Public domain 2004 James Van Buskirk
7! Second attempt to actually create function with LEN
8! given by specification expression via function name,
9! and SIZE given by specification expression via
10! result name.
11
12! g95 12/18/04: Error: Circular specification in variable 'r'.
13! ISO/IEC 1539-1:1997(E) section 512.5.2.2:
14! "If RESULT is specified, the name of the result variable
15! of the function is result-name, its characteristics
16! (12.2.2) are those of the function result, and..."
17! Also from the same section:
18! The type and type parameters (if any) of the result of the
19! function subprogram may be specified by a type specification
20! in the FUNCTION statement or by the name of the result variable
21! appearing in a type statement in the declaration part of the
22! function subprogram.  It shall not be specified both ways."
23! Also in section 7.1.6.2:
24! "A restricted expression is one in which each operation is
25! intrinsic and each primary is
26! ...
27! (7) A reference to an intrinsic function that is
28! ...
29!     (c) the character inquiry function LEN,
30! ...
31!     and where each primary of the function is
32! ...
33!     (b) a variable whose properties inquired about are not
34!         (i)   dependent on the upper bound of the last
35!               dimension of an assumed-shape array.
36!         (ii)  defined by an expression that is not a
37!               restricted expression
38!         (iii) definable by an ALLOCATE or pointer
39!               assignment statement."
40! So I think there is no problem with the specification of
41! the function result attributes; g95 flunks.
42
43! CVF 6.6C3: Error: This name does not have a type, and must
44! have an explicit type. [R]
45! Clearly R has a type here: the type and type parameters of
46! the function result; CVF flunks.
47
48! LF95 5.70f: Type parameters or bounds of variable r may
49! not be inquired.
50! Again, the type parameters, though not the bounds, of
51! variable r may in fact be inquired; LF95 flunks.
52
53module test1
54   implicit none
55   contains
56      character(f (x)) function test2 (x) result(r)
57         implicit integer (x)
58         dimension r(modulo (len (r) - 1, 3) + 1)
59         integer, intent(in) :: x
60         interface
61            pure function f (x)
62               integer, intent(in) :: x
63               integer f
64            end function f
65         end interface
66         integer i
67
68         do i = 1, len (r)
69            r(:)(i:i) = achar (mod (i, 32) + iachar ('@'))
70         end do
71      end function test2
72end module test1
73
74program test
75   use test1
76   implicit none
77   character(21) :: chr (3)
78   chr = "ABCDEFGHIJKLMNOPQRSTU"
79
80   if (len (test2 (10)) .ne. 21) call abort ()
81   if (any (test2 (10) .ne. chr)) call abort ()
82end program test
83
84pure function f (x)
85   integer, intent(in) :: x
86   integer f
87
88   f = 2*x+1
89end function f
90