Gfortran ignores error in dummy array specification

Consider the following excerpt from a student code :slight_smile:

program pot
  implicit none
  real, allocatable :: tab(:,:)
  integer :: m

  read(*,*) m
  allocate(tab(m,m))
  call sub(tab)

contains

  subroutine sub(tab)
    real, intent(inout) :: tab(m,m)
    integer :: m                        ! WRONG 
    print *, m, size(tab)
  end subroutine sub

end program pot

The m variable in sub should be either passed as a dummy, intent(in) argument or accessed by host association from main program. Intel Fortran reports an error:

$ ifx p.f90
p.f90(14): error #7157: This name has been incorrectly used in a specification expression of a contained procedure.   [M]
    integer :: m
---------------^

Gfortran, unfortunately, compiles the code silently, then giving somewhat strange output:

$ gfortran p.f90 && ./a.out
3
       32610           9

so the m variable has a random value, as expected, but tab(m,m) shows its proper size, as passed from main program.
Interestingly, if one exchanges the declariation statements in sub:

  subroutine sub(tab)
    integer :: m
    real, intent(inout) :: tab(m,m)

gfortran reports an error (actually, two errors, for each m):

p.f90:14:31:
   14 |     real, intent(inout) :: tab(m,m)
      |                               1
Error: Variable 'm' cannot appear in the expression at (1)

Any comments? Could that be possible (standard conforming), that the error/no-error condition depends on the order of declarations?

1 Like

The order of declarations do matter. The F2023 standard says (in “10.1.11 Specification expression”):

So, upon declaration of real, intent(inout) :: tab(m,m), gfortran rightly uses the m by host association. However, it should report an error when encountering integer :: m afterwards, as the local m now contradicts the host associated m that is already in use in the scoping unit.

When moving integer :: m at the first position, the local m gets precedence over the host associated m, which is “shadowed”.

1 Like

There are at least 2 questions here:

One is “can the order of declarations make the difference between conforming and non-conforming code?”.

The answer is yes.

The other is "Can one of these particular variants be standard conforming?

The answer is no.

19.5.1.4 Host association says " A name that appears in the scoping unit as […] an object-name in an entity-decl in a type-declaration-stmt […] is a local identifier in the scoping unit and any entity of the host that has this as its nongeneric name is inaccessible by that name by host association."

That is our line in SUB

integer :: m                        ! WRONG 

And this makes the TAB specification wrong, because M (being a local identifier that is not a constant, not a subobject of a constant, not a dummy, not “an object designator with a base object that is in a common block”, and not use or host associated) is not a valid specification expression for bounds.

I think that “shall” in the text you quoted places the burden to comply on the programmer, not the compiler. As you say, a good compiler should recognize the problem and hopefully report a useful error message, but I don’t think it is required to do so.

Related to the above issue, as a user I would like the compiler not to allow using parent-scope variables like m above by default; if I want to use parent variables, I would like to import them explicitly. This would prevent the above error, among other benefits.

2 Likes

Most compilers -if not all- do not enforce the declaration order. But the reported problem is different here: gfortran is messing up between the host associated m and the local m inside the sub() routine: it starts using the former, then goes on with the latter.