Some compilers print ? with this program. Others refuse to compile it. I haven’t found in the Fortran 2023 standard what should have happened, because len is not a kind type parameter.
integer :: linelen = 80
character(linelen) :: line
line = '?'
print *, trim(line)
end program
I agree that in a declaration like character(linelen) :: line the integer linelen must not be a variable, but I didn’t find this morning where the standard says so. F2023 R721 says that KIND= would require a constant but I should have looked at C805, which says “A type-param-value in a char-length in an entity-decl shall be a colon, asterisk, or specification expression.” I can now report some compiler bugs.
Within a subprogram, it can be, for example, a dummy argument or a module variable or an expression that involves those variables. I’m unsure about any additional restrictions within a main program. For example, I think the following slightly modified program is standard conforming.
program xxx
integer :: linelen = 80
call sub()
contains
subroutine sub()
character(linelen) :: line
line = '?'
print *, len(line), trim(line)
end subroutine sub
end program xxx
Here the linelen variable is host associated, which is another allowed possibility. However, if the declaration of linelen is moved from the main program to within the contained subroutine, it again becomes nonconforming.
[edit] Here is another slightly modified version of the original code that appears to be standard conforming.
program xxx
integer :: linelen = 80
block
character(linelen) :: line
line = '?'
print *, len(line), trim(line)
end block
end program xxx
As above, if the declaration of linelen is moved to within the block structure, the program no longer compiles.
this is what the standard calls “automatic data object”, see section 8.3 of the F2023 standard. All variables used in type parameter (be it kind or length) must be known on entry to the subprogram or block.
I agree that the standard could say explicitly that in the main program unit the type parameters must be constant expressions but I also could not find such a statement (which does not necessarily mean there is none) for the length (it is a general rule for kind, C701)
@Pieru, my program disobeyed f2023 C805 because its character length was an ordinary variable. The bug in two compilers was accepting it. I have already reported it to lfortran but the other compiler has recently issued a new version, which I have not yet downloaded. I won’t send its developers a bug report unless their new version still has that bug.
Is this the key difference in the versions that work and those that don’t? Here is another version that works.
module linex
integer :: linelen = 80
end module linex
program xxx
block
use linex
character(linelen) :: line
line = '?'
print *, len(line), trim(line)
end block
end program xxx
This one uses a module variable (that is initialized and has implicit save). The entire main program is within a block. If the block and end block statements are removed, it does not compile. I don’t know why the language would be designed this way. Maybe it was not on purpose? In any case, there are several workarounds, so it isn’t really a practical restriction, just a nuisance where the programmer must find the right incantation.
The other compiler was AMD flang. Its version 5.0.0 still has the bug. I have told them. On the difference between kind and length type parameters the standard is helpful but I found shorter explanations elsewhere.
“The Fortran 2003 Handbook” by Jeanne C. Adams et al. (Springer, 2008) section 4.2.2 says that kind type parameters must be known at compile time but length type parameter values may, in some cases, be determined or changed at run time. (My program had no modules or subprograms, so that determining or changing something at run time was not an option.)
Similar wording is in “Fortran 95/2003 Explained” (Oxford, 2004) Section 15.4 and “Modern Fortran Explained”, both by Michael Metcalf et al. (Oxford, 2023) section 13.2. Both sections are headed “Parameterized derived types” but contain information needed by users of the intrinsic character type as well.
A specification-expr shall be a constant expression unless it is in an interface body (15.4.3.2), the specification part of a subprogram or BLOCK construct, a derived type definition, or the declaration-type-spec of a FUNCTION statement
This is why the original program is invalid but @RonShepard’s example where line is declared inside a block is valid. Even though they look equivalent.
This is apparently a subtle point, and I’ve posted several very similar versions, some valid and some not. The version with the integer declaration (and initialization, so it has implicit save) inside the block is not valid, but if the integer declaration is moved outside the block, but still within the main program, then it is valid. Another version has the integer declaration and initialization within a module, and in that case the block is still required in the main program, but it does not matter where the USE statement is, either outside or inside the block both seem to work.
Rereading the standard showed me that a specification expression may be an integer in a common block, and that initialization was permitted in block data. So I thought this program would be valid. Both gfortran and ifx disagree. Where is my error?
block data nspec
integer:: n = 2
common /spec/ n
end block data nspec
program commonspec
implicit none
integer:: n
external nspec
common /spec/ n
character(n) c
c = 'xy'
print *,c
end program commonspec
Compile-time output from gfortran:
commonspec.f90:11:16:
11 | character(n) c
| 1
Error: ‘c’ at (1) must have constant character length in this context
Your test code appears to work with nvfortran 24.7 and AMD AOOC 4.2.0 (flang) compilers. No compile errors and both print “xy”. Both are based on “classic” flang. It would be interesting to see if it works with new flang or LFortran. So the question (that happens all to often with current generation Fortran compilers) is “Who is right”.
The latest flang (AMD AOCC version 5.0.0) printed ‘xy’. Lfortran 0.41.0 gave “Internal Compiler Error: Unhandled exception” and a traceback, followed by this line that was helpful but disappointing:
LCompilersException: visit_BlockData() not implemented
On trying to use common but not block data I wrote the program below. Lfortran gave a semantic error, gfortran reminded me why I had tried using block data, and AMD flang 5.0.0 printed ‘xy’ even with the -Mstandard -Wall options. The program:
program blockless
implicit none
integer:: n = 2
common /spec/ n
character(n) c
c = 'xy'
print *,c
end program blockless
The lfortran 0.41.0 error message:
semantic error: Only Integers or variables implemented so far for `len` expressions, found: i32
--> blockless.f90:5:3
|
5 | character(n) c
| ^^^^^^^^^^^^^^
The gfortran 14.2.0 error message:
blockless.f90:4:17:
4 | common /spec/ n
| 1
Warning: GNU Extension: Initialized symbol ‘n’ at (1) can only be COMMON in BLOCK DATA
blockless.f90:3:13:
3 | integer:: n = 2
| 1
Warning: GNU Extension: Variable ‘n’ at (1) is in COMMON but only in BLOCK DATA initialization is allowed
blockless.f90:5:16:
5 | character(n) c
| 1
Error: ‘c’ at (1) must have constant character length in this context
A declaration of an object in the starting section of the main program unit, other than of an allocatable object, is a once and for good, so I do not see any reason for it to allow a variable size (be it array specs or character length). So the requirement for it to be a constant is well justified.
In all other environments (subprograms, blocks) the chances are high that the object will be actually defined many times, on multiple entries to those envs (even to blocks in main unit!), thus automatic data object, parametrized by a variable known on the entry is very useful, giving a (easier to use) simple alternative to allocatable objects (which, of course, give much more options to use).
subroutine s1(n)
integer :: n
character(len=n) :: str
real :: tab(n,2*n)
end subroutine s1
subroutine s2(n)
integer :: n, k=23
character, allocatable :: str(:)
real, allocatable :: tab(:,:), t(:)
allocate(str(n))
allocate(tab(n,2*n))
allocate(t(k)) ! only with allocatables
end subroutine s2
My guess is also that an entry to a block construct is functionally very similar to an entry to a subprogram. So while putting the whole executable code of a main unit into a block construct does make the trick but does not make much sense as the very idea of the block construct is to somewhat isolate its content from the outside world.
It is easy to construct many counter arguments. 1) One might want to allocate automatic arrays in both the main program and in subroutines using the same variable; at present, the programmer must define both a parameter constant and a variable for that purpose, and having two entities rather than one is at least redundant, if not confusing. 2) Placing arbitrary constraints on the main program destroys the symmetry of the syntax.
Maybe someone knows the actual reason for the current situation, but my guess is that it was simply an oversight. F77 did not require the compiler to support any automatic objects, so this issue did not arise in the language before f90. F90 introduced automatic objects in subprograms, keeping the main program constraints the same as before.
Requiring that specification expressions in the specification part of non-subprogram program units be constant expressions avoids all the complexity (implementation and language specification) that would be otherwise associated with getting the order of just-before-runtime initialization correct if more general specification expressions were permitted.
A block construct is an executable construct. It is executed at a very well defined point in the life of a program, ordering considerations are trivial.
I do not see any asymmetry here. You just cannot use
integer :: n=22
character(len=n) :: str
anywhere in a Fortran program (i.e. in the same unit/block). To use a variable in that context, it has to be known by some kind of association upon entry to the unit/block. This naturally limits such use to subprograms/blocks.