Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Occult specific name REAL

11 views
Skip to first unread message

James Van Buskirk

unread,
Dec 8, 2010, 2:43:11 PM12/8/10
to
As I mentioned earlier, the REAL intrinsic and its specific names
are a more difficult problem in verification. Since REAL is marked
with a bullet in section 13.6 of N1830.pdf and it is a generic name,
it seems that there can be no way to test whether a compiler
implements it as a specific name. However, if we consider that
every word in the normative parts of the standard have an effect, we
can use 4 methods to try to detect the presence of the REAL specific
name, if only through error messages. Note first that the gfortran
manual doesn't list REAL as a specific name, which is at least a bug
in documentation. The 4 methods:

1) Try to invoke a procedure with REAL as an actual argument.
2) Try to point a procedure pointer at REAL.
3) Try to use REAL as the interface-name in a procedure declaration
statement.
4) Try to use REAL as the initial-proc-target in the proc-decl-list
in a procedure declaration statement.

Of course all of these are illegal under the Fortran standard because
REAL is marked with a bullet in section 13.6.

C:\gfortran\clf\quadtest>type realspecs1a.f90
module mod1a
implicit none
contains
subroutine sub1(f)
implicit none
interface
function f(x)
implicit none
real f
integer(1), intent(in) :: x
end function f
end interface
end subroutine sub1

subroutine sub2(f)
implicit none
interface
function f(x)
implicit none
real f
integer(2), intent(in) :: x
end function f
end interface
end subroutine sub2

subroutine sub3(f)
implicit none
interface
function f(x)
implicit none
real f
integer(4), intent(in) :: x
end function f
end interface
end subroutine sub3

subroutine sub4(f)
implicit none
interface
function f(x)
implicit none
real f
integer(8), intent(in) :: x
end function f
end interface
end subroutine sub4

subroutine sub5(f)
implicit none
interface
function f(x)
implicit none
real f
integer(16), intent(in) :: x
end function f
end interface
end subroutine sub5

subroutine sub6(f)
implicit none
interface
function f(x)
implicit none
real f
real(4), intent(in) :: x
end function f
end interface
end subroutine sub6

subroutine sub7(f)
implicit none
interface
function f(x)
implicit none
real f
real(8), intent(in) :: x
end function f
end interface
end subroutine sub7

subroutine sub8(f)
implicit none
interface
function f(x)
implicit none
real f
real(10), intent(in) :: x
end function f
end interface
end subroutine sub8

subroutine sub9(f)
implicit none
interface
function f(x)
implicit none
real f
real(16), intent(in) :: x
end function f
end interface
end subroutine sub9

subroutine sub10(f)
implicit none
interface
function f(x)
implicit none
real f
complex(4), intent(in) :: x
end function f
end interface
end subroutine sub10

subroutine sub11(f)
implicit none
interface
function f(x)
implicit none
real f
complex(8), intent(in) :: x
end function f
end interface
end subroutine sub11

subroutine sub12(f)
implicit none
interface
function f(x)
implicit none
real f
complex(10), intent(in) :: x
end function f
end interface
end subroutine sub12

subroutine sub13(f)
implicit none
interface
function f(x)
implicit none
real f
complex(16), intent(in) :: x
end function f
end interface
end subroutine sub13
end module mod1a

program realspecs1a
use mod1a
implicit none
intrinsic real

call sub1(real)
call sub2(real)
call sub3(real)
call sub4(real)
call sub5(real)
call sub6(real)
call sub7(real)
call sub8(real)
call sub9(real)
call sub10(real)
call sub11(real)
call sub12(real)
call sub13(real)
end program realspecs1a

C:\gfortran\clf\quadtest>gfortran -fmax-errors=0
realspecs1a.f90 -orealspecs1a
realspecs1a.f90:153.13:

call sub1(real)
1
Error: Intrinsic 'real' at (1) is not allowed as an actual argument
realspecs1a.f90:153.13:

call sub1(real)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'
realspecs1a.f90:154.13:

call sub2(real)
1
Error: Intrinsic 'real' at (1) is not allowed as an actual argument
realspecs1a.f90:154.13:

call sub2(real)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'
realspecs1a.f90:155.13:

call sub3(real)
1
Error: Intrinsic 'real' at (1) is not allowed as an actual argument
realspecs1a.f90:155.13:

call sub3(real)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'
realspecs1a.f90:156.13:

call sub4(real)
1
Error: Intrinsic 'real' at (1) is not allowed as an actual argument
realspecs1a.f90:156.13:

call sub4(real)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'
realspecs1a.f90:157.13:

call sub5(real)
1
Error: Intrinsic 'real' at (1) is not allowed as an actual argument
realspecs1a.f90:157.13:

call sub5(real)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'
realspecs1a.f90:158.13:

call sub6(real)
1
Error: Intrinsic 'real' at (1) is not allowed as an actual argument
realspecs1a.f90:158.13:

call sub6(real)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'
realspecs1a.f90:159.13:

call sub7(real)
1
Error: Intrinsic 'real' at (1) is not allowed as an actual argument
realspecs1a.f90:159.13:

call sub7(real)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'
realspecs1a.f90:160.13:

call sub8(real)
1
Error: Intrinsic 'real' at (1) is not allowed as an actual argument
realspecs1a.f90:160.13:

call sub8(real)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'
realspecs1a.f90:161.13:

call sub9(real)
1
Error: Intrinsic 'real' at (1) is not allowed as an actual argument
realspecs1a.f90:161.13:

call sub9(real)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'
realspecs1a.f90:162.14:

call sub10(real)
1
Error: Intrinsic 'real' at (1) is not allowed as an actual argument
realspecs1a.f90:162.14:

call sub10(real)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'
realspecs1a.f90:163.14:

call sub11(real)
1
Error: Intrinsic 'real' at (1) is not allowed as an actual argument
realspecs1a.f90:163.14:

call sub11(real)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'
realspecs1a.f90:164.14:

call sub12(real)
1
Error: Intrinsic 'real' at (1) is not allowed as an actual argument
realspecs1a.f90:164.14:

call sub12(real)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'
realspecs1a.f90:165.14:

call sub13(real)
1
Error: Intrinsic 'real' at (1) is not allowed as an actual argument
realspecs1a.f90:165.14:

call sub13(real)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'

A total wasteland of error messages with no hint of a matching
specific. But this really can work:

C:\gfortran\clf\quadtest>type realspecs1b.f90
module mod1b
implicit none
contains
subroutine sub1(f)
implicit none
interface
function f(x)
implicit none
real f
integer(1), intent(in) :: x
end function f
end interface
end subroutine sub1

subroutine sub2(f)
implicit none
interface
function f(x)
implicit none
real f
integer(2), intent(in) :: x
end function f
end interface
end subroutine sub2

subroutine sub3(f)
implicit none
interface
function f(x)
implicit none
real f
integer(4), intent(in) :: x
end function f
end interface
end subroutine sub3

subroutine sub4(f)
implicit none
interface
function f(x)
implicit none
real f
integer(8), intent(in) :: x
end function f
end interface
end subroutine sub4

subroutine sub5(f)
implicit none
interface
function f(x)
implicit none
real f
integer(16), intent(in) :: x
end function f
end interface
end subroutine sub5

subroutine sub6(f)
implicit none
interface
function f(x)
implicit none
real f
real(4), intent(in) :: x
end function f
end interface
end subroutine sub6

subroutine sub7(f)
implicit none
interface
function f(x)
implicit none
real f
real(8), intent(in) :: x
end function f
end interface
end subroutine sub7

subroutine sub8(f)
implicit none
interface
function f(x)
implicit none
real f
real(10), intent(in) :: x
end function f
end interface
end subroutine sub8

subroutine sub9(f)
implicit none
interface
function f(x)
implicit none
real f
real(16), intent(in) :: x
end function f
end interface
end subroutine sub9

subroutine sub10(f)
implicit none
interface
function f(x)
implicit none
real f
complex(4), intent(in) :: x
end function f
end interface
end subroutine sub10

subroutine sub11(f)
implicit none
interface
function f(x)
implicit none
real f
complex(8), intent(in) :: x
end function f
end interface
end subroutine sub11

subroutine sub12(f)
implicit none
interface
function f(x)
implicit none
real f
complex(10), intent(in) :: x
end function f
end interface
end subroutine sub12

subroutine sub13(f)
implicit none
interface
function f(x)
implicit none
real f
complex(16), intent(in) :: x
end function f
end interface
end subroutine sub13
end module mod1b

program realspecs1b
use mod1b
implicit none
intrinsic float

call sub1(float)
call sub2(float)
call sub3(float)
call sub4(float)
call sub5(float)
call sub6(float)
call sub7(float)
call sub8(float)
call sub9(float)
call sub10(float)
call sub11(float)
call sub12(float)
call sub13(float)
end program realspecs1b

C:\gfortran\clf\quadtest>gfortran -fmax-errors=0
realspecs1b.f90 -orealspecs1b
realspecs1b.f90:153.13:

call sub1(float)
1
Error: Intrinsic 'float' at (1) is not allowed as an actual argument
realspecs1b.f90:153.13:

call sub1(float)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'
realspecs1b.f90:154.13:

call sub2(float)
1
Error: Intrinsic 'float' at (1) is not allowed as an actual argument
realspecs1b.f90:154.13:

call sub2(float)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'
realspecs1b.f90:155.13:

call sub3(float)
1
Error: Intrinsic 'float' at (1) is not allowed as an actual argument
realspecs1b.f90:156.13:

call sub4(float)
1
Error: Intrinsic 'float' at (1) is not allowed as an actual argument
realspecs1b.f90:156.13:

call sub4(float)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'
realspecs1b.f90:157.13:

call sub5(float)
1
Error: Intrinsic 'float' at (1) is not allowed as an actual argument
realspecs1b.f90:157.13:

call sub5(float)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'
realspecs1b.f90:158.13:

call sub6(float)
1
Error: Intrinsic 'float' at (1) is not allowed as an actual argument
realspecs1b.f90:158.13:

call sub6(float)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'
realspecs1b.f90:159.13:

call sub7(float)
1
Error: Intrinsic 'float' at (1) is not allowed as an actual argument
realspecs1b.f90:159.13:

call sub7(float)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'
realspecs1b.f90:160.13:

call sub8(float)
1
Error: Intrinsic 'float' at (1) is not allowed as an actual argument
realspecs1b.f90:160.13:

call sub8(float)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'
realspecs1b.f90:161.13:

call sub9(float)
1
Error: Intrinsic 'float' at (1) is not allowed as an actual argument
realspecs1b.f90:161.13:

call sub9(float)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'
realspecs1b.f90:162.14:

call sub10(float)
1
Error: Intrinsic 'float' at (1) is not allowed as an actual argument
realspecs1b.f90:162.14:

call sub10(float)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'
realspecs1b.f90:163.14:

call sub11(float)
1
Error: Intrinsic 'float' at (1) is not allowed as an actual argument
realspecs1b.f90:163.14:

call sub11(float)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'
realspecs1b.f90:164.14:

call sub12(float)
1
Error: Intrinsic 'float' at (1) is not allowed as an actual argument
realspecs1b.f90:164.14:

call sub12(float)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'
realspecs1b.f90:165.14:

call sub13(float)
1
Error: Intrinsic 'float' at (1) is not allowed as an actual argument
realspecs1b.f90:165.14:

call sub13(float)
1
Error: Interface mismatch in dummy procedure 'f' at (1): Type/rank mismatch
in a
rgument 'x'

And we see that in this case there was a deviation at sub3,
indicating that specific name FLOAT takes an INTEGER(4) argument and
returns a REAL(4) result as specified in the standard and gfortran
documentation.

Since method 1 failed, we must try method 2:

C:\gfortran\clf\quadtest>type realspecs2a.f90
module mod2a
implicit none
abstract interface
function f1(x)
implicit none
integer(1), intent(in) :: x
real f1
end function f1
function f2(x)
implicit none
integer(2), intent(in) :: x
real f2
end function f2
function f3(x)
implicit none
integer(4), intent(in) :: x
real f3
end function f3
function f4(x)
implicit none
integer(8), intent(in) :: x
real f4
end function f4
function f5(x)
implicit none
integer(16), intent(in) :: x
real f5
end function f5
function f6(x)
implicit none
real(4), intent(in) :: x
real f6
end function f6
function f7(x)
implicit none
real(8), intent(in) :: x
real f7
end function f7
function f8(x)
implicit none
real(10), intent(in) :: x
real f8
end function f8
function f9(x)
implicit none
real(16), intent(in) :: x
real f9
end function f9
function f10(x)
implicit none
complex(4), intent(in) :: x
real f10
end function f10
function f11(x)
implicit none
complex(8), intent(in) :: x
real f11
end function f11
function f12(x)
implicit none
complex(10), intent(in) :: x
real f12
end function f12
function f13(x)
implicit none
complex(16), intent(in) :: x
real f13
end function f13
end interface
end module mod2a

program realspecs2a
use mod2a
implicit none
intrinsic real
procedure(f1), pointer :: g1
procedure(f2), pointer :: g2
procedure(f3), pointer :: g3
procedure(f4), pointer :: g4
procedure(f5), pointer :: g5
procedure(f6), pointer :: g6
procedure(f7), pointer :: g7
procedure(f8), pointer :: g8
procedure(f9), pointer :: g9
procedure(f10), pointer :: g10
procedure(f11), pointer :: g11
procedure(f12), pointer :: g12
procedure(f13), pointer :: g13

g1 => real
g2 => real
g3 => real
g4 => real
g5 => real
g6 => real
g7 => real
g8 => real
g9 => real
g10 => real
g11 => real
g12 => real
g13 => real
end program realspecs2a

C:\gfortran\clf\quadtest>gfortran realspecs2a.f90 -orealspecs2a
realspecs2a.f90:90.9:

g1 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs2a.f90:91.9:

g2 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs2a.f90:92.9:

g3 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs2a.f90:93.9:

g4 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs2a.f90:94.9:

g5 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs2a.f90:95.9:

g6 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs2a.f90:96.9:

g7 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs2a.f90:97.9:

g8 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs2a.f90:98.9:

g9 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs2a.f90:99.10:

g10 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs2a.f90:100.10:

g11 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs2a.f90:101.10:

g12 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs2a.f90:102.10:

g13 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'

Again an interface mismatch in every case. But we could create
a procedure pointer with an implicit interface and point it at
REAL then try to invoke it and see what happens:

C:\gfortran\clf\quadtest>type realspecs2b.f90
program realspecs2b
implicit none
intrinsic real
real, external :: f
procedure(real(kind(1.0))), pointer :: g

g => real
end program realspecs2b

C:\gfortran\clf\quadtest>gfortran realspecs2b.f90 -orealspecs2b
realspecs2b.f90: In function 'realspecs2b':
realspecs2b.f90:7:0: internal compiler error: in gfc_typenode_for_spec, at
fortr
an/trans-types.c:1020
Please submit a full bug report,
with preprocessed source if appropriate.
See <http://gcc.gnu.org/bugs.html> for instructions.

OK, so that attempt didn't get very far, but what happens with
method 3?

C:\gfortran\clf\quadtest>type realspecs3a.f90
module mod3a
implicit none
contains
function f1(x)
implicit none
integer(1), intent(in) :: x
real f1
f1 = x
end function f1
function f2(x)
implicit none
integer(2), intent(in) :: x
real f2
f2 = x
end function f2
function f3(x)
implicit none
integer(4), intent(in) :: x
real f3
f3 = x
end function f3
function f4(x)
implicit none
integer(8), intent(in) :: x
real f4
f4 = x
end function f4
function f5(x)
implicit none
integer(16), intent(in) :: x
real f5
f5 = x
end function f5
function f6(x)
implicit none
real(4), intent(in) :: x
real f6
f6 = x
end function f6
function f7(x)
implicit none
real(8), intent(in) :: x
real f7
f7 = x
end function f7
function f8(x)
implicit none
real(10), intent(in) :: x
real f8
f8 = x
end function f8
function f9(x)
implicit none
real(16), intent(in) :: x
real f9
f9 = x
end function f9
function f10(x)
implicit none
complex(4), intent(in) :: x
real f10
f10 = x
end function f10
function f11(x)
implicit none
complex(8), intent(in) :: x
real f11
f11 = x
end function f11
function f12(x)
implicit none
complex(10), intent(in) :: x
real f12
f12 = x
end function f12
function f13(x)
implicit none
complex(16), intent(in) :: x
real f13
f13 = x
end function f13
end module mod3a

program realspecs3a
use ISO_FORTRAN_ENV
use mod3a
implicit none
intrinsic real
real(REAL_KINDS(1)) r4
complex(REAL_KINDS(1)) c4
real(REAL_KINDS(2)) r8
complex(REAL_KINDS(2)) c8
real(REAL_KINDS(3)) r10
complex(REAL_KINDS(3)) c10
real(REAL_KINDS(4)) r16
complex(REAL_KINDS(4)) c16
integer(INTEGER_KINDS(1)) i1
integer(INTEGER_KINDS(2)) i2
integer(INTEGER_KINDS(3)) i4
integer(INTEGER_KINDS(4)) i8
integer(INTEGER_KINDS(5)) i16
procedure(real), pointer :: g

c4 = (1,2)
c8 = (3,4)
c10 = (5,6)
c16 = (7,8)
r4 = 9
r8 = 10
r10 = 11
r16 = 12
i1 = 13
i2 = 14
i4 = 15
i8 = 16
i16 = 17
g => f1
write(*,*) g(i1)
g => f2
write(*,*) g(i2)
g => f3
write(*,*) g(i4)
g => f4
write(*,*) g(i8)
g => f5
write(*,*) g(i16)
g => f6
write(*,*) g(r4)
g => f7
write(*,*) g(r8)
g => f8
write(*,*) g(r10)
g => f9
write(*,*) g(r16)
g => f10
write(*,*) g(c4)
g => f11
write(*,*) g(c8)
g => f12
write(*,*) g(c10)
g => f13
write(*,*) g(c16)
end program realspecs3a

C:\gfortran\clf\quadtest>gfortran realspecs3a.f90 -orealspecs3a

C:\gfortran\clf\quadtest>realspecs3a
13.000000
14.000000
15.000000
16.000000
17.000000
9.0000000
10.000000
11.000000
12.000000
1.0000000
3.0000000
5.0000000
7.0000000

It looks like something worked, but this is an illusion caused
by the collision between the specific name REAL and the type
name REAL. If we resolve this collision to say what we mean
we get:

C:\gfortran\clf\quadtest>type realspecs3b.f90
module mod3b
implicit none
intrinsic real
contains
function f1(x)
implicit none
integer(1), intent(in) :: x
real f1
f1 = x
end function f1
function f2(x)
implicit none
integer(2), intent(in) :: x
real f2
f2 = x
end function f2
function f3(x)
implicit none
integer(4), intent(in) :: x
real f3
f3 = x
end function f3
function f4(x)
implicit none
integer(8), intent(in) :: x
real f4
f4 = x
end function f4
function f5(x)
implicit none
integer(16), intent(in) :: x
real f5
f5 = x
end function f5
function f6(x)
implicit none
real(4), intent(in) :: x
real f6
f6 = x
end function f6
function f7(x)
implicit none
real(8), intent(in) :: x
real f7
f7 = x
end function f7
function f8(x)
implicit none
real(10), intent(in) :: x
real f8
f8 = x
end function f8
function f9(x)
implicit none
real(16), intent(in) :: x
real f9
f9 = x
end function f9
function f10(x)
implicit none
complex(4), intent(in) :: x
real f10
f10 = x
end function f10
function f11(x)
implicit none
complex(8), intent(in) :: x
real f11
f11 = x
end function f11
function f12(x)
implicit none
complex(10), intent(in) :: x
real f12
f12 = x
end function f12
function f13(x)
implicit none
complex(16), intent(in) :: x
real f13
f13 = x
end function f13
end module mod3b

program realspecs3b
use ISO_FORTRAN_ENV
use mod3b, realfun => real
implicit none
intrinsic real
real(REAL_KINDS(1)) r4
complex(REAL_KINDS(1)) c4
real(REAL_KINDS(2)) r8
complex(REAL_KINDS(2)) c8
real(REAL_KINDS(3)) r10
complex(REAL_KINDS(3)) c10
real(REAL_KINDS(4)) r16
complex(REAL_KINDS(4)) c16
integer(INTEGER_KINDS(1)) i1
integer(INTEGER_KINDS(2)) i2
integer(INTEGER_KINDS(3)) i4
integer(INTEGER_KINDS(4)) i8
integer(INTEGER_KINDS(5)) i16
procedure(realfun), pointer :: g

c4 = (1,2)
c8 = (3,4)
c10 = (5,6)
c16 = (7,8)
r4 = 9
r8 = 10
r10 = 11
r16 = 12
i1 = 13
i2 = 14
i4 = 15
i8 = 16
i16 = 17
g => f1
write(*,*) g(i1)
g => f2
write(*,*) g(i2)
g => f3
write(*,*) g(i4)
g => f4
write(*,*) g(i8)
g => f5
write(*,*) g(i16)
g => f6
write(*,*) g(r4)
g => f7
write(*,*) g(r8)
g => f8
write(*,*) g(r10)
g => f9
write(*,*) g(r16)
g => f10
write(*,*) g(c4)
g => f11
write(*,*) g(c8)
g => f12
write(*,*) g(c10)
g => f13
write(*,*) g(c16)
end program realspecs3b

C:\gfortran\clf\quadtest>gfortran -fmax-errors=0
realspecs3b.f90 -orealspecs3b
realspecs3b.f90:103.20:

procedure(realfun), pointer :: g
1
Error: Intrinsic procedure 'real' not allowed in PROCEDURE statement at (1)
realspecs3b.f90:118.10:

g => f1
1
Error: Function 'f1' requires an argument list at (1)
realspecs3b.f90:120.4:

g => f2
1
Error: 'g' at (1) is not a variable
realspecs3b.f90:122.4:

g => f3
1
Error: 'g' at (1) is not a variable
realspecs3b.f90:124.4:

g => f4
1
Error: 'g' at (1) is not a variable
realspecs3b.f90:126.4:

g => f5
1
Error: 'g' at (1) is not a variable
realspecs3b.f90:128.4:

g => f6
1
Error: 'g' at (1) is not a variable
realspecs3b.f90:130.4:

g => f7
1
Error: 'g' at (1) is not a variable
realspecs3b.f90:132.4:

g => f8
1
Error: 'g' at (1) is not a variable
realspecs3b.f90:134.4:

g => f9
1
Error: 'g' at (1) is not a variable
realspecs3b.f90:136.4:

g => f10
1
Error: 'g' at (1) is not a variable
realspecs3b.f90:138.4:

g => f11
1
Error: 'g' at (1) is not a variable
realspecs3b.f90:140.4:

g => f12
1
Error: 'g' at (1) is not a variable
realspecs3b.f90:142.4:

g => f13
1
Error: 'g' at (1) is not a variable
realspecs3b.f90:119.13:

write(*,*) g(i1)
1
Error: Function 'g' at (1) has no IMPLICIT type
realspecs3b.f90:121.13:

write(*,*) g(i2)
1
Error: Function 'g' at (1) has no IMPLICIT type
realspecs3b.f90:123.13:

write(*,*) g(i4)
1
Error: Function 'g' at (1) has no IMPLICIT type
realspecs3b.f90:125.13:

write(*,*) g(i8)
1
Error: Function 'g' at (1) has no IMPLICIT type
realspecs3b.f90:127.13:

write(*,*) g(i16)
1
Error: Function 'g' at (1) has no IMPLICIT type
realspecs3b.f90:129.13:

write(*,*) g(r4)
1
Error: Function 'g' at (1) has no IMPLICIT type
realspecs3b.f90:131.13:

write(*,*) g(r8)
1
Error: Function 'g' at (1) has no IMPLICIT type
realspecs3b.f90:133.13:

write(*,*) g(r10)
1
Error: Function 'g' at (1) has no IMPLICIT type
realspecs3b.f90:135.13:

write(*,*) g(r16)
1
Error: Function 'g' at (1) has no IMPLICIT type
realspecs3b.f90:137.13:

write(*,*) g(c4)
1
Error: Function 'g' at (1) has no IMPLICIT type
realspecs3b.f90:139.13:

write(*,*) g(c8)
1
Error: Function 'g' at (1) has no IMPLICIT type
realspecs3b.f90:141.13:

write(*,*) g(c10)
1
Error: Function 'g' at (1) has no IMPLICIT type
realspecs3b.f90:143.13:

write(*,*) g(c16)
1
Error: Function 'g' at (1) has no IMPLICIT type

So that didn't help. Finally method 4:

C:\gfortran\clf\quadtest>type realspecs4a.f90
module mod4a
implicit none
abstract interface
function f1(x)
implicit none
integer(1), intent(in) :: x
real f1
end function f1
function f2(x)
implicit none
integer(2), intent(in) :: x
real f2
end function f2
function f3(x)
implicit none
integer(4), intent(in) :: x
real f3
end function f3
function f4(x)
implicit none
integer(8), intent(in) :: x
real f4
end function f4
function f5(x)
implicit none
integer(16), intent(in) :: x
real f5
end function f5
function f6(x)
implicit none
real(4), intent(in) :: x
real f6
end function f6
function f7(x)
implicit none
real(8), intent(in) :: x
real f7
end function f7
function f8(x)
implicit none
real(10), intent(in) :: x
real f8
end function f8
function f9(x)
implicit none
real(16), intent(in) :: x
real f9
end function f9
function f10(x)
implicit none
complex(4), intent(in) :: x
real f10
end function f10
function f11(x)
implicit none
complex(8), intent(in) :: x
real f11
end function f11
function f12(x)
implicit none
complex(10), intent(in) :: x
real f12
end function f12
function f13(x)
implicit none
complex(16), intent(in) :: x
real f13
end function f13
end interface
end module mod4a

program realspecs4a
use mod4a
implicit none
intrinsic real
procedure(f1), pointer :: g1 => real
procedure(f2), pointer :: g2 => real
procedure(f3), pointer :: g3 => real
procedure(f4), pointer :: g4 => real
procedure(f5), pointer :: g5 => real
procedure(f6), pointer :: g6 => real
procedure(f7), pointer :: g7 => real
procedure(f8), pointer :: g8 => real
procedure(f9), pointer :: g9 => real
procedure(f10), pointer :: g10 => real
procedure(f11), pointer :: g11 => real
procedure(f12), pointer :: g12 => real
procedure(f13), pointer :: g13 => real
end program realspecs4a

C:\gfortran\clf\quadtest>gfortran realspecs4a.f90 -orealspecs4a
realspecs4a.f90:76.39:

procedure(f1), pointer :: g1 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs4a.f90:85.41:

procedure(f10), pointer :: g10 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs4a.f90:86.41:

procedure(f11), pointer :: g11 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs4a.f90:87.41:

procedure(f12), pointer :: g12 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs4a.f90:88.41:

procedure(f13), pointer :: g13 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs4a.f90:77.39:

procedure(f2), pointer :: g2 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs4a.f90:78.39:

procedure(f3), pointer :: g3 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs4a.f90:79.39:

procedure(f4), pointer :: g4 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs4a.f90:80.39:

procedure(f5), pointer :: g5 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs4a.f90:81.39:

procedure(f6), pointer :: g6 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs4a.f90:82.39:

procedure(f7), pointer :: g7 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs4a.f90:83.39:

procedure(f8), pointer :: g8 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'
realspecs4a.f90:84.39:

procedure(f9), pointer :: g9 => real
1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank
mism
atch in argument 'x'

So instead we try to point a procedure pointer with an implicit
interface at REAL by method 4:

C:\gfortran\clf\quadtest>type realspecs4b.f90
program realspecs4b
implicit none
intrinsic real
procedure(real(kind(1.0))), pointer :: f => real
end program realspecs4b

C:\gfortran\clf\quadtest>gfortran realspecs4b.f90 -orealspecs4b

C:\gfortran\clf\quadtest>realspecs4b

This looks sort of promising, but it doesn't do anything.
Let's go further and try to invoke REAL through that
procedure pointer:

C:\gfortran\clf\quadtest>type realspecs4c.f90
program realspecs4c
implicit none
intrinsic real
procedure(real(kind(1.0))), pointer :: f => real

write(*,*) f(1)
end program realspecs4c

C:\gfortran\clf\quadtest>gfortran realspecs4c.f90 -orealspecs4c
realspecs4c.f90: In function 'realspecs4c':
realspecs4c.f90:6:0: internal compiler error: in gfc_typenode_for_spec, at
fortr
an/trans-types.c:1020
Please submit a full bug report,
with preprocessed source if appropriate.
See <http://gcc.gnu.org/bugs.html> for instructions.

Or maybe point another procedure pointer at it:

C:\gfortran\clf\quadtest>type realspecs4d.f90
program realspecs4d
implicit none
intrinsic real
procedure(real(kind(1.0))), pointer :: f => real
procedure(real(kind(1.0))), pointer :: h

h => f
end program realspecs4d

C:\gfortran\clf\quadtest>gfortran realspecs4d.f90 -orealspecs4d
realspecs4d.f90: In function 'realspecs4d':
realspecs4d.f90:7:0: internal compiler error: in gfc_typenode_for_spec, at
fortr
an/trans-types.c:1020
Please submit a full bug report,
with preprocessed source if appropriate.
See <http://gcc.gnu.org/bugs.html> for instructions.

Or point another procedure pointer at it as a recursive
application of method 4:

C:\gfortran\clf\quadtest>type realspecs4e.f90
program realspecs4e
implicit none
intrinsic real
procedure(real(kind(1.0))), pointer :: f => real
procedure(real(kind(1.0))), pointer :: h => f

write(*,*) h(1)
end program realspecs4e

C:\gfortran\clf\quadtest>gfortran realspecs4e.f90 -orealspecs4e
realspecs4e.f90: In function 'realspecs4e':
realspecs4e.f90:7:0: internal compiler error: in gfc_typenode_for_spec, at
fortr
an/trans-types.c:1020
Please submit a full bug report,
with preprocessed source if appropriate.
See <http://gcc.gnu.org/bugs.html> for instructions.

Or try to pass it as an argument to another procedure:

C:\gfortran\clf\quadtest>type realspecs4f.f90
program realspecs4f
implicit none
intrinsic real
procedure(real(kind(1.0))), pointer :: f => real

call sub(f)
end program realspecs4f

subroutine sub(x)
implicit none
real, external :: x
end subroutine sub

C:\gfortran\clf\quadtest>gfortran realspecs4f.f90 -orealspecs4f
realspecs4f.f90: In function 'realspecs4f':
realspecs4f.f90:6:0: internal compiler error: in gfc_typenode_for_spec, at
fortr
an/trans-types.c:1020
Please submit a full bug report,
with preprocessed source if appropriate.
See <http://gcc.gnu.org/bugs.html> for instructions.

Well, none of these methods allowed me to detect a specific name
REAL, so I am led to believe that the gfortran manual accurately
documents the bug that gfortran doesn't implement the specific
name REAL.

--
write(*,*) transfer((/17.392111325966148d0,6.5794487871554595D-85, &
6.0134700243160014d-154/),(/'x'/)); end


0 new messages