Gfortran-15 bug/regression

Dear all,

Recently, I’ve updated the gfortran compiler to gfortran-15 on an ARM Mac laptop. Since then, I’ve encountered a strange error in a library that uses a function as an argument for another function.

Type mismatch at (1) passing global function ‘sqrt_perso’ declared at (2) (UNKNOWN/REAL(8))

The error is not present with gfortran-14 (or 11).
Furthermore, when the function is not called sqrt_perso but f, the code compile perfectly with gfortran-15 (comment/uncomment lines 9/10)

The following minimal code gives the error:

PROGRAM test
  USE, intrinsic :: ISO_FORTRAN_ENV, ONLY : Rkind=>real64
  implicit none

  real(kind=Rkind) :: x
  real(kind=Rkind), external :: f,SQRT_perso

  x=1._Rkind
  write(*,*) x,f(x),dnf2(x,SQRT_perso) ! Type mismatch error with gfortran-15
  !write(*,*) x,f(x),dnf2(x,f)          ! No error !!
CONTAINS
  FUNCTION dnf2(xx,ff)
    USE, intrinsic :: ISO_FORTRAN_ENV, ONLY : Rkind=>real64

    real(kind=Rkind)   :: dnf2
    real(kind=Rkind), intent(in) :: xx
    real(kind=Rkind), external   :: ff
    
    real(kind=Rkind), parameter :: h=0.001_Rkind

    dnf2 = ff(xx+xx)

  END FUNCTION dnf2
END PROGRAM test

FUNCTION SQRT_perso(x) RESULT(r)
  USE, intrinsic :: ISO_FORTRAN_ENV, ONLY : Rkind=>real64
  IMPLICIT NONE
  real (kind=Rkind) :: r
  real (kind=Rkind), intent(in) :: x

  r = sqrt(x)

END FUNCTION SQRT_perso

FUNCTION f(x) RESULT(r)
  USE, intrinsic :: ISO_FORTRAN_ENV, ONLY : Rkind=>real64
  implicit none

  real(kind=Rkind) :: r
  real(kind=Rkind), intent(in) :: x

  r = sqrt(x)

END FUNCTION f

I found several ways to overcome this problem, but I’m wondering whether the code is correct or if there is a bug in gfortran-15?

1 Like

Maybe I’m overlooking something, but I don’t think there is anything wrong with the code. As you say, you can make trivial changes to the code to make it work. For example, if you move the external function code within the file to before the main program instead of after, then it works.

gfortran tries to generate and check interfaces to external functions when the code for the function is visible to the compiler. I think it is trying to do that here, but it gets something wrong in the process.

1 Like

I also got the same error on my macM1 + gfortran-15.1, but gfortran-15 (trunk) on CompilerExplorer gives no error, so possibly already fixed…?

The only thing that occurs to me regarding your code is that externalattribute in declaration of ffinside the function dnf2is not needed, as it is only required in the unit(s) in which the given function is used as an actual argument in calling another procedure. Here, it is only explicitly used as function,dnf2=ff(xx+xx)so the external is redundant.

could it be related to: mctc-lib 0.4.1 does not compile due to interface mismatch · Issue #83 · grimme-lab/mctc-lib · GitHub ?

I agree with the gist of this statement, but in f77 the external statement also guaranteed that if a compiler had, or later added, an intrinsic function named ff(), then it would be the external function that was referenced rather than the intrinsic. F77 was a rather primitive language by modern fortran standards, and most (perhaps all) compilers had many nonstandard intrinsic function to do various things. So using the external declaration was a way to make your code bulletproof against either nonstandard intrinsics or against future changes to the fortran standard itself.

Nowadays, there are several other ways to provide an interface to dummy argument procedures (e.g. a local interface block, or a procedure() declaration, or a reference to an interface block in a module, etc.) and that is preferred over the simple external declaration. But the external declaration is still part of the language for backwards compatibility and for legacy code.

That is true but I guess it is irrelevant when the function in question (as in the OP) is a dummy argument. Consider:

program test
  real, external :: fun
  real :: x=0.4, y
  call sub(fun, x, y)
  print *, y
end program test

real function fun(x)
  real :: x
  fun = 2*x
end function fun

subroutine sub(sin, a, b)
  real :: sin, a, b
  b = sin(a)
end subroutine sub

Both ifxand gfortran compile the code w/o any warning. And the output is 0.800000 so obviously the funfunction is called by sin(a)in the subroutine, not the intrinsic sine.

BTW, in F77 there was another (third) use for EXTERNAL, a bit related to what you have mentioned, namely to guarantee that a separately compiled BLOCK DATA segment(s) are linked into the executable. You put a name to BLOCK DATA segment and then use the name in EXTERNAL declaration elsewhere in the code. The difference between this use and the intrinsic/external distinction is that the absence of BLOCK DATA segment in the linking process would otherwise go undetected as there is no other way to reference it (contrary to a function, which gets called somewhere in the source).

Back up one level and change fun to sin everywhere. With the external attribute, then it will be the user-written sin() function that is referenced as the actual argument. Without that attribute (or without a separate external statement in the f77 code), then it would be the intrinsic sin() function that is referenced. There is also the intrinsic statement to guarantee this behavior, and, like the external statement, to act as documentation to a human looking at the code.

This situation is complicated a little with overloaded intrinsic functions such as sin(), particularly when the compiler supports several real kinds. Nowadays, not all of the specific functions have standard names, so the programmer must write a small interface function and use that as the actual argument.

My understanding is that if an intrinsic function is to be used as actual argument of a subprogram, F77 requires it to be declared intrinsic(in the segment where it is used as such), complementary to user functions required to be declared external in such a case. In the subprogram being called, the dummy subprogram argument does not need to be declared external unless it is passed down the chain of calls.

Now it is mostly gone, as you say, with the use of intrinsic specific names being deprecated, or maybe even prohibited by the latest standards.

1 Like

This feature was important when a block data was included in a static library. The external statement was a way to trigger the linker to include the block data in the executable file.

Years ago I filed a bug with the gfortran folks on this, because they don’t issue the proper external reference in the .o file containing the external statement. (Because the name wasn’t actually used in a call or as a function name they elided it.) They chose to ignore my reasoning, and to this day do it wrong. But I guess it is less of an issue now due to the use of modules and also shared libraries.

I don’t think this behavior was ever a part of the fortran standard. Object file management was always, and still is, outside the standard. I do know that it worked for a lot of compilers and library archives, but it was just a common feature, not required by the fortran standard and not required by any OS standard for the loader or object library manager (e.g. posix ld and ar).

There were several workarounds for this, all of them kind of quirky. You could compile the block data along with one of the other fortran files that was included in the library, or along with the main program if that was practical, or in a separate *.o file not in the library. I’m not sure which of those was the most portable.

Maybe someone with more knowledge of loaders and libraries can fill in the details.

It isn’t specifically spelled out in the Fortran standard. (Any of them.) But pretty much every compiler environment I used up until gfortran supported it.

A very long time ago, Fortran 66 days, I was helping develop a package which had a large library, and a bunch of programs which linked to it. The systems back then didn’t support shared libs. So using the external trick was important.

Since Fortran 90 introduced modules, thereby obsoleting common blocks and block data, it really hasn’t been a problem that I’d imagine the Committee have given any thought to. Especially since Fortran 2018…

Well, below is an excerpt from F77 standard relating to EXTERNALin context of BLOCK DATAname. It explicitly specifies that a block data unit name may be used in EXTERNALdeclaration. And also that this name is a global entity. Surely a language standard does not specify the details of executable linking process but it is hard to imagine that it could work differently in a combination of EXTERNAL bdname+ BLOCK DATA bdname and CALL sub()+ SUBROUTINE sub()Calling a subroutine or (non-intrinsic) function in F77 declares it to be external. So would guess that in both cases the linking process cannot succeed without including either the block data or the subprogram declared as external.

8.7 EXTERNAL_Statement
Appearance of a name in an EXTERNAL statement declares that name
to be an external procedure name or dummy procedure
name, or block data subprogram name.

16.1 BLOCK_DATA_Statement
BLOCK DATA [sub]

where sub is the symbolic name of the block data
subprogram in which the BLOCK DATA statement appears.
The optional name sub is a global name (18.1.1) and
must not be the same as the name of an external
procedure, main program, common block, or other block
data subprogram in the same executable program. The
name sub must not be the same as any local name in the
subprogram.

This is really an issue of how loaders search through object libraries. The fortran standard text quoted above is a separate issue; namely that once the block data name has appeared in a program unit, then it means that intrinsics and other external functions cannot use that name in the same scope. The standard does not address how the object files are managed (by ar on a posix system) or how the loader (ld on a posix system) searches that library to resolve its external symbols.

In the 80s I programmed on vax vms, a variety of unix systems (bsd, system v, and hybrids), and several other OS types (such as ibm mvs, dec tops-10 and tops-20, univac EXEC 8, cray COS, cray CTSS, harris VOS, data general AOS, and probably a few others). They all seemed to work a little differently and they all had their quirks. One of the features that I remember about the vax system was that you could compile a fortran file with several subroutines, and when that file was added to the library each subroutine was its own entry, as if it had been compiled alone in a file and added to the library just by itself. The nice feature of this approach was that when you linked to make the executable it would only extract the subroutines that were actually referenced and needed by the program, giving the smallest executable files – memory then was a precious and limited resource. I think the same thing would occur for a function or subroutine declared as EXTERNAL but then not actually referenced in the program, the linker would eventually just ignore it. I remember there was a flag where you could tell the vms linker to load a particular object file even if it wasn’t referenced. Maybe it was /force=name or something like that? I think that option was specifically for things like fortran block data that might not be loaded otherwise (since there was not a function reference by that name in the program to trigger its inclusion).

On the other hand, the unix/posix systems did not do that. They all seemed to create a single object file for each compiled file that was thereafter treated as a single entity within the object library. If any single function within that file was referenced, then the whole object file was loaded into the program. There are both advantages and disadvantages to this approach compared to the vax approach. For example, it sometimes resulted in larger executable files than necessary since unused and unreferenced functions were loaded into your program. But on the other hand, it solved the block data program because you could compile the block data in the same file as another function, and if that other function was grabbed from the library by the loader, then it would also pull in the block data.

I remember organizing files in vax vms so that I had dozens of related subroutines in each file, so even a large program might end up with only few dozen files. Then when porting to unix machines, I would fsplit those files to edit/ar/ld each subprogram separately. Then when f90+ came along, I regrouped those separate related files into modules, arriving back at something like the earlier vax vms organization.

Another approach back then was to not include the block data into the library, but rather load its object file directly. Another useful approach was to include the block data into the same file as the main program, and then when the main program object file was loaded (usually directly, not from a library), it would pull in the various block data units along with it.

In all of those operating systems I used back then, there was always some kind of workaround for fortran block data. Of course, other languages often have similar features with different names, initialized data that must be loaded into the executable, so this was not just a fortran issue, but also an issue with many other languages, including the various assemblers on all of those machines.

True. One other nuance is that in strict F66, block data program units could not be named. However this was widely extended to allow them to be named. F77 standardized the practice.

I suspect a major reason the standards folks did not go further with it was that overlaying was still commonly done. And some of the art of overlaying had to do with which common blocks went in which overlays - sometimes replicated in multiple overlays, sometimes not. Linkers varied considerably in how the programmer specified what went where.

1 Like