An array constructor can contain a type specification followed by :: . However, the following small program:
MODULE m
TYPE tp
INTEGER(4) i
END TYPE tp
END MODULE m
PROGRAM t
USE m
TYPE (tp) v1,v2,v3
v1%i = 1
v2%i = 2
v3%i = 3
CALL s([TYPE(tp) :: v1,v2,v3])
END PROGRAM t
SUBROUTINE s(va)
USE m
TYPE(tp) va(3)
WRITE(*,*)va
END SUBROUTINE s
fails to compile under gfortran, GNU Fortran (Ubuntu 11.4.0-1ubuntu1~22.04) 11.4.0, with:
(lf) john@gemsbok:~/projects/WinFPT/fpt/fpttest$ gfortran t.f90
t.f90:34:26:
34 | CALL s([TYPE(tp) :: v1,v2,v3])
| 1
Error: Syntax error in array constructor at (1)
and under ifx: ifx (IFX) 2025.1.1 20250418
t.f90(34): error #6457: This derived type name has not been declared. [TYPE]
CALL s([TYPE(tp) :: v1,v2,v3])
----------------^
lfortran has no problem:
(lf) john@gemsbok:~/projects/WinFPT/fpt/fpttest$ lfortran --version
LFortran version: 0.51.0
Platform: Linux
LLVM: 19.1.1
Default target: x86_64-conda-linux-gnu
(lf) john@gemsbok:~/projects/WinFPT/fpt/fpttest$ lfortran t.f90
1 2 3
Is there something I have missed?
As written, the type declaration in the array constructor adds nothing but documentation. However we have 2 projects where we convert all real and complex variables to derived types, to experiment with precision and with units and dimensions, and I can see problems arising with these.
ifx 2025.1, and recent nvfortran and AMD flang report a syntax error so there is something else going on here if what you are tryin to do is actually conforming code.
works with ifx 2025.1 and gfortran 13.1 but fails with nvfortran and AMD flang which give almost identical error messages. I guess because they are both based on “classic” flang.
type :: type(fp)
integer, kind :: fp = 4
integer(fp) :: i
end type
?
And this derived type:
TYPE tp
INTEGER(4) i
END TYPE tp
Must use [tp :: v1,v2,v3]?
If so, we’ll fix it in LFortran. I didn’t know that, I thought you can use integer and type(integer) interchangeably, and I thought to reference a derived type you always had to do type(tp).
The standard makes a distinction between type-spec and declaration-type-spec. Both coincide for intrinsic types, but for derived types type-spec refers only to name and parameters. That also holds true for the enumeration-type.
For array constructors, the type-spec is the one used before ::.
If you want to declare that v1, v2 and v3 are of derived type tp you write: TYPE (tp) :: v1,v2,v3
But if you want to specify that v1, v2 and v3 are of type tp in an array constructor you write: [ tp :: v1,v2,v3 ]
Please forgive me if I do not find this to be a consistent piece of language design, but, like hundreds of other special cases, it can be done. fpt will understand it tomorrow. And, sadly, lfortran is wrong.
This is just speculation, but I guess type-spec is for cases where the type is concrete or already understood, e.g., in a structure constructor, the type-guard of a select-type-construct and so on.
The syntax has been there at least since Fortran 90. I really would have hated the idea of having to initialize a derived type variable as:
The simple array expression [v1,v2,v3] already does that because those variables are already declared to be of that type. I think the type-spec within an array constructor is really to convert types (+kinds) when necessary. I think my most common usage of that syntax is to specify an array of fixed length characters, where the input elements themselves might have varying lengths. [character(len=8) :: 'one', 'two', 'three', 'four']
In this case, there are conversions occurring. Another situation like this might be
[complex(wp) :: 0, 1.0, 2.0d0, (3.0_wp,4.0_wp)]
In this case, there are both type and kind conversions occurring. These could be variables or parameters instead of literal constants.
It was mentioned above that this has been in the language since f90, but I don’t think that is correct. F90 did have array constructors, delimited by (/ and /), but it was the programmer’s responsibility to ensure that all the elements were of the same type and kind, and in particular that all character arrays had input elements that were the same length. I don’t know offhand when the type-spec was added, maybe f2003?
What I meant was that syntax using the (derived-)type-spec is in the language since F90, at least for structure constructors (the code snippet shows what would have been used without the type-spec). But for array constructors, it was probably an F2003 addition?
The Fortran 2003 Handbook shows it as being part of F2003 but the only examples it gives is for intrinsic kinds but nothing in the description (see page 112) says its restricted to intrinsics. It shows the allowed form as.
[ type-spec :: ac-value-list]
and references what I think is a section in the standard (R465).
It does show an interesting use for this that I never thought of before.
Another case, new in F2023, where type_spec is useful in an array constructor is if an element is a boz-literal-constant and the compiler needs to be told whether it’s real or integer because 7.7 paragraph 1 says “Such a constant has no type”.
“[ ] won’t work” is a reminder that although there is only one empty set, an array is not a set. 3 compilers gave good error messages with this program but gfortran ran it, giving empty output.
print "(L2)", [real:: ] == [logical:: ]
end program
Yes I know an empty [ ] won’t work at least when I read in the Fortran 2003 handbook section I referenced that it wouldn’t. I didn’t know you could do this because I have never had need to use a zero length array for anything. I played around with this a little hoping that specifying the type in the constructor would solve the precision problem you have trying to use default real literal constants to initialize REAL64 arrays.
ie
[real(REAL64) :: 1, 2, 3.14, 4]
Does not give you the same results as
[real(REAL64) :: 1, 2, 3.14_REAL64,4]
I probably should not have expected the first example to work but one can hope. Note having to always append the KIND attribute to a literal constant to actually get what you want when initializing either a scalar or an array is to my mind kind of silly but thats what you have to do.
Long ago I said while walking down a street with my daughter aged 5, who had seen some set theory at school, “The set of green crocodiles in this street is the same as the set of pink elephants in it”. Her reply “How do you know there isn’t a green crocodile hiding behind that tree?” forced me to say “The sets of visible green crocodiles and visible pink elephants”.
It is just a choice in the language. In this case, the rule is that a literal constant always has the same value, regardless of context. The rule is simple and easy to remember for a human. It would not matter to a compiler how complicated the rule is, but it makes a difference to us humans trying to understand how expressions are evaluated. If the language consisted of a large number of special cases, it would be more difficult to use, not easier. And if the rule were changed now, it would make some 60 years of legacy code inconsistent.
Having said that, there is a language proposal to allow default kinds to be redefined within a scoping unit. That can be done in a backwards compatible way, and it would reduce the need to specify kind values for literal constants in many cases. The question remains if it will make code easier or harder to understand.