- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
The following code does not compile anymore with Intel 21.7, while it is compiling with all versions of Intel 19, Intel 20 and Intel <=21.5.
Could you please report this to the Intel development team. This is pretty bad for our code.
module ifiles
implicit none
private
public :: ifile_t
public :: ifile_clear
public :: ifile_final
public :: ifile_read
public :: ifile_write
public :: ifile_get_length
public :: line_p
public :: line_init
public :: line_final
public :: line_advance
public :: line_backspace
public :: line_is_associated
public :: line_get_index
public :: line_get_length
type :: line_entry_t
private
type(line_entry_t), pointer :: previous => null ()
type(line_entry_t), pointer :: next => null ()
integer :: index
end type line_entry_t
type :: ifile_t
private
type(line_entry_t), pointer :: first => null ()
type(line_entry_t), pointer :: last => null ()
integer :: n_lines = 0
contains
procedure :: final => ifile_clear
end type ifile_t
type :: line_p
private
type(line_entry_t), pointer :: p => null ()
end type line_p
interface ifile_final
module procedure ifile_clear
end interface
interface ifile_read
module procedure ifile_read_from_char
module procedure ifile_read_from_unit
module procedure ifile_read_from_char_array
module procedure ifile_read_from_ifile
end interface
interface
module subroutine ifile_clear (ifile)
class(ifile_t), intent(inout) :: ifile
end subroutine ifile_clear
module subroutine ifile_read_from_char (ifile, char)
type(ifile_t), intent(inout) :: ifile
character(*), intent(in) :: char
end subroutine ifile_read_from_char
module subroutine ifile_read_from_char_array (ifile, char)
type(ifile_t), intent(inout) :: ifile
character(*), dimension(:), intent(in) :: char
end subroutine ifile_read_from_char_array
module subroutine ifile_read_from_unit (ifile, unit, iostat)
type(ifile_t), intent(inout) :: ifile
integer, intent(in) :: unit
integer, intent(out), optional :: iostat
end subroutine ifile_read_from_unit
module subroutine ifile_read_from_ifile (ifile, ifile_in)
type(ifile_t), intent(inout) :: ifile
type(ifile_t), intent(in) :: ifile_in
end subroutine ifile_read_from_ifile
module subroutine ifile_write (ifile, unit, iostat)
type(ifile_t), intent(in) :: ifile
integer, intent(in), optional :: unit
integer, intent(out), optional :: iostat
end subroutine ifile_write
module function ifile_get_length (ifile) result (length)
integer :: length
type(ifile_t), intent(in) :: ifile
end function ifile_get_length
module subroutine line_init (line, ifile, back)
type(line_p), intent(inout) :: line
type(ifile_t), intent(in) :: ifile
logical, intent(in), optional :: back
end subroutine line_init
module subroutine line_final (line)
type(line_p), intent(inout) :: line
end subroutine line_final
module subroutine line_advance (line)
type(line_p), intent(inout) :: line
end subroutine line_advance
module subroutine line_backspace (line)
type(line_p), intent(inout) :: line
end subroutine line_backspace
module function line_is_associated (line) result (ok)
logical :: ok
type(line_p), intent(in) :: line
end function line_is_associated
module function line_get_index (line) result (index)
integer :: index
type(line_p), intent(in) :: line
end function line_get_index
module function line_get_length (line) result (length)
integer :: length
type(line_p), intent(in) :: line
end function line_get_length
end interface
end module ifiles
module lexers
use ifiles, only: ifile_t
use ifiles, only: line_p
implicit none
private
public :: stream_t
public :: stream_init
public :: stream_final
public :: keyword_list_t
public :: keyword_list_write
public :: keyword_list_final
public :: T_KEYWORD, T_IDENTIFIER, T_QUOTED, T_NUMERIC
public :: lexeme_t
public :: lexeme_write
public :: lexeme_get_type
public :: lexeme_is_break
public :: lexeme_is_eof
public :: lexer_t
public :: lexer_init
public :: lexer_clear
public :: lexer_final
public :: lexer_assign_stream
public :: lex
public :: lexer_put_back
public :: lexer_write_setup
public :: lexer_show_location
integer, parameter :: T_KEYWORD = 1
integer, parameter :: T_IDENTIFIER = 2, T_QUOTED = 3, T_NUMERIC = 4
integer, parameter :: EMPTY = 0, WHITESPACE = 10
integer, parameter :: NO_MATCH = 11, IO_ERROR = 12, OVERFLOW = 13
integer, parameter :: UNMATCHED_QUOTE = 14
integer, parameter :: CASE_KEEP = 0, CASE_UP = 1, CASE_DOWN = 2
type :: stream_t
integer, pointer :: unit => null ()
type(ifile_t), pointer :: ifile => null ()
type(line_p), pointer :: line => null ()
integer :: record = 0
logical :: eof = .false.
contains
generic :: init => &
stream_init_filename, &
stream_init_unit, &
stream_init_ifile, &
stream_init_line
procedure, private :: stream_init_filename
procedure, private :: stream_init_unit
procedure, private :: stream_init_ifile
procedure, private :: stream_init_line
procedure :: final => stream_final
end type stream_t
type :: keyword_entry_t
private
type(keyword_entry_t), pointer :: next => null ()
end type keyword_entry_t
type :: keyword_list_t
private
type(keyword_entry_t), pointer :: first => null ()
type(keyword_entry_t), pointer :: last => null ()
end type keyword_list_t
type :: template_t
!!! !!! Compiler bug in ifort 20/21/22: no structure constants for
!!! !!! types with private components in submodules possible
!!! private
integer :: type
character(256) :: charset1, charset2
integer :: len1, len2
end type template_t
type :: lexer_setup_t
private
type(template_t), dimension(:), allocatable :: tt
integer, dimension(:), allocatable :: type
integer :: keyword_case = CASE_KEEP
type(keyword_list_t), pointer :: keyword_list => null ()
end type lexer_setup_t
type :: lexeme_t
private
integer :: type = EMPTY
integer :: b = 0, e = 0
end type lexeme_t
type :: lexer_t
private
type(lexer_setup_t) :: setup
type(stream_t), pointer :: stream => null ()
type(lexeme_t) :: lexeme
integer :: lines_read = 0
integer :: current_column = 0
integer :: previous_column = 0
type(lexer_t), pointer :: parent => null ()
contains
procedure :: init => lexer_init
procedure :: clear => lexer_clear
procedure :: final => lexer_final
procedure :: assign_stream => lexer_assign_stream
end type lexer_t
interface stream_init
module procedure stream_init_filename
module procedure stream_init_unit
module procedure stream_init_ifile
module procedure stream_init_line
end interface
interface keyword_list_write
module procedure keyword_list_write_unit
end interface
interface
module subroutine stream_init_filename (stream, filename)
class(stream_t), intent(out) :: stream
character(*), intent(in) :: filename
end subroutine stream_init_filename
module subroutine stream_init_unit (stream, unit)
class(stream_t), intent(out) :: stream
integer, intent(in) :: unit
end subroutine stream_init_unit
module subroutine stream_init_ifile (stream, ifile)
class(stream_t), intent(out) :: stream
type(ifile_t), intent(in) :: ifile
end subroutine stream_init_ifile
module subroutine stream_init_line (stream, line)
class(stream_t), intent(out) :: stream
type(line_p), intent(in) :: line
end subroutine stream_init_line
module subroutine stream_final (stream)
class(stream_t), intent(inout) :: stream
end subroutine stream_final
module subroutine keyword_list_write_unit (keylist, unit)
type(keyword_list_t), intent(in) :: keylist
integer, intent(in) :: unit
end subroutine keyword_list_write_unit
module subroutine keyword_list_final (keylist)
type(keyword_list_t), intent(inout) :: keylist
end subroutine keyword_list_final
module subroutine lexeme_write (t, unit)
type(lexeme_t), intent(in) :: t
integer, intent(in) :: unit
end subroutine lexeme_write
module function lexeme_get_type (t) result (type)
integer :: type
type(lexeme_t), intent(in) :: t
end function lexeme_get_type
module function lexeme_is_break (t) result (break)
logical :: break
type(lexeme_t), intent(in) :: t
end function lexeme_is_break
module function lexeme_is_eof (t) result (ok)
logical :: ok
type(lexeme_t), intent(in) :: t
end function lexeme_is_eof
module subroutine lexer_init (lexer, &
comment_chars, quote_chars, quote_match, &
single_chars, special_class, &
keyword_list, upper_case_keywords, &
parent)
class(lexer_t), intent(inout) :: lexer
character(*), intent(in) :: comment_chars
character(*), intent(in) :: quote_chars, quote_match
character(*), intent(in) :: single_chars
character(*), dimension(:), intent(in) :: special_class
type(keyword_list_t), pointer :: keyword_list
logical, intent(in), optional :: upper_case_keywords
type(lexer_t), target, intent(in), optional :: parent
end subroutine lexer_init
module subroutine lexer_clear (lexer)
class(lexer_t), intent(inout) :: lexer
end subroutine lexer_clear
module subroutine lexer_final (lexer)
class(lexer_t), intent(inout) :: lexer
end subroutine lexer_final
module subroutine lexer_assign_stream (lexer, stream)
class(lexer_t), intent(inout) :: lexer
type(stream_t), intent(in), target :: stream
end subroutine lexer_assign_stream
module subroutine lex (lexeme, lexer)
type(lexeme_t), intent(out) :: lexeme
type(lexer_t), intent(inout) :: lexer
end subroutine lex
module subroutine lexer_put_back (lexer, lexeme)
type(lexer_t), intent(inout) :: lexer
type(lexeme_t), intent(in) :: lexeme
end subroutine lexer_put_back
module subroutine lexer_write_setup (lexer, unit)
type(lexer_t), intent(in) :: lexer
integer, intent(in), optional :: unit
end subroutine lexer_write_setup
module subroutine lexer_show_location (lexer)
type(lexer_t), intent(in) :: lexer
end subroutine lexer_show_location
end interface
end module lexers
module syntax_rules
use ifiles, only: ifile_t
use lexers
implicit none
private
public :: S_UNKNOWN
public :: S_LOGICAL, S_INTEGER, S_REAL, S_COMPLEX, S_QUOTED
public :: S_IDENTIFIER, S_KEYWORD
public :: S_SEQUENCE, S_LIST, S_GROUP, S_ARGS
public :: S_ALTERNATIVE
public :: S_IGNORE
public :: syntax_rule_get_type
public :: syntax_rule_get_n_sub
public :: syntax_rule_get_sub_ptr
public :: syntax_rule_last_optional
public :: syntax_rule_last_repetitive
public :: syntax_rule_is_atomic
public :: syntax_rule_write
public :: syntax_t
public :: syntax_init
integer, parameter :: &
S_UNKNOWN = 0, &
S_LOGICAL = 1, S_INTEGER = 2, S_REAL = 3, S_COMPLEX = 4, &
S_QUOTED = 5, S_IDENTIFIER = 6, S_KEYWORD = 7, &
S_SEQUENCE = 8, S_LIST = 9, S_GROUP = 10, S_ARGS = 11, &
S_ALTERNATIVE = 12, &
S_IGNORE = 99
type :: rule_p
private
type(syntax_rule_t), pointer :: p => null ()
end type rule_p
public :: syntax_rule_t
type :: syntax_rule_t
private
integer :: type = S_UNKNOWN
logical :: used = .false.
type(rule_p), dimension(:), allocatable :: child
character(1) :: modifier = ""
logical :: opt = .false., rep = .false.
contains
procedure :: write => syntax_rule_write
end type syntax_rule_t
type :: syntax_t
private
type(syntax_rule_t), dimension(:), allocatable :: rule
type(keyword_list_t) :: keyword_list
end type syntax_t
interface syntax_init
module procedure syntax_init_from_ifile
end interface
interface
module function syntax_rule_get_type (rule) result (type)
integer :: type
type(syntax_rule_t), intent(in) :: rule
end function syntax_rule_get_type
module function syntax_rule_get_sub_ptr (rule, i) result (sub)
type(syntax_rule_t), pointer :: sub
type(syntax_rule_t), intent(in), target :: rule
integer, intent(in) :: i
end function syntax_rule_get_sub_ptr
module function syntax_rule_get_n_sub (rule) result (n)
integer :: n
type(syntax_rule_t), intent(in) :: rule
end function syntax_rule_get_n_sub
module function syntax_rule_last_optional (rule) result (opt)
logical :: opt
type(syntax_rule_t), intent(in) :: rule
end function syntax_rule_last_optional
module function syntax_rule_last_repetitive (rule) result (rep)
logical :: rep
type(syntax_rule_t), intent(in) :: rule
end function syntax_rule_last_repetitive
module function syntax_rule_is_atomic (rule) result (atomic)
logical :: atomic
type(syntax_rule_t), intent(in) :: rule
end function syntax_rule_is_atomic
module subroutine syntax_rule_write (rule, unit, short, key_only, advance)
class(syntax_rule_t), intent(in) :: rule
integer, intent(in), optional :: unit
logical, intent(in), optional :: short, key_only, advance
end subroutine syntax_rule_write
module subroutine syntax_init_from_ifile (syntax, ifile)
type(syntax_t), intent(out), target :: syntax
type(ifile_t), intent(in) :: ifile
end subroutine syntax_init_from_ifile
end interface
end module syntax_rules
submodule (syntax_rules) syntax_rules_s
use ifiles, only: ifile_get_length
use ifiles, only: line_p, line_init, line_final
implicit none
contains
elemental function rule_is_associated (rp) result (ok)
logical :: ok
type (rule_p), intent(in) :: rp
end function rule_is_associated
module function syntax_rule_get_type (rule) result (type)
integer :: type
type(syntax_rule_t), intent(in) :: rule
end function syntax_rule_get_type
module function syntax_rule_get_n_sub (rule) result (n)
integer :: n
type(syntax_rule_t), intent(in) :: rule
end function syntax_rule_get_n_sub
module function syntax_rule_get_sub_ptr (rule, i) result (sub)
type(syntax_rule_t), pointer :: sub
type(syntax_rule_t), intent(in), target :: rule
integer, intent(in) :: i
end function syntax_rule_get_sub_ptr
subroutine syntax_rule_set_sub (rule, i, sub)
type(syntax_rule_t), intent(inout) :: rule
integer, intent(in) :: i
type(syntax_rule_t), intent(in), target :: sub
end subroutine syntax_rule_set_sub
module function syntax_rule_last_optional (rule) result (opt)
logical :: opt
type(syntax_rule_t), intent(in) :: rule
end function syntax_rule_last_optional
module function syntax_rule_last_repetitive (rule) result (rep)
logical :: rep
type(syntax_rule_t), intent(in) :: rule
end function syntax_rule_last_repetitive
module function syntax_rule_is_atomic (rule) result (atomic)
logical :: atomic
type(syntax_rule_t), intent(in) :: rule
end function syntax_rule_is_atomic
module subroutine syntax_rule_write (rule, unit, short, key_only, advance)
class(syntax_rule_t), intent(in) :: rule
integer, intent(in), optional :: unit
logical, intent(in), optional :: short, key_only, advance
end subroutine syntax_rule_write
subroutine syntax_rule_check (rule)
type(syntax_rule_t), intent(in) :: rule
end subroutine syntax_rule_check
!!! Intel 21.7 Regression
module subroutine syntax_init_from_ifile (syntax, ifile)
type(syntax_t), intent(out), target :: syntax
type(ifile_t), intent(in) :: ifile
end subroutine syntax_init_from_ifile
end submodule syntax_rules_s
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
This is the regression in the latest ifort 2021.7 and ifx 2022.2. There is no error with 2021.6 and 2022.1 compiler versions. It is escalated to the developers and should be corrected in the upcoming compiler versions. Thank you for reporting it.
Link Copied
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Sorry for not providing a shorter version earlier, but here is a reproducer of only 72 lines:
module ifiles
implicit none
private
public :: ifile_t
public :: line_p
type :: ifile_t
end type ifile_t
type :: line_p
end type line_p
end module ifiles
module lexers
use ifiles, only: ifile_t
use ifiles, only: line_p
implicit none
private
public :: stream_t
type :: stream_t
type(ifile_t), pointer :: ifile => null ()
type(line_p), pointer :: line => null ()
end type stream_t
type :: keyword_entry_t
private
type(keyword_entry_t), pointer :: next => null ()
end type keyword_entry_t
end module lexers
module syntax_rules
use ifiles, only: ifile_t
use lexers
implicit none
private
public :: syntax_t
public :: syntax_init
public :: syntax_rule_t
type :: rule_p
private
type(syntax_rule_t), pointer :: p => null ()
end type rule_p
type :: syntax_rule_t
private
type(rule_p), dimension(:), allocatable :: child
end type syntax_rule_t
type :: syntax_t
private
type(syntax_rule_t), dimension(:), allocatable :: rule
end type syntax_t
interface syntax_init
module procedure syntax_init_from_ifile
end interface
interface
module subroutine syntax_init_from_ifile (syntax, ifile)
type(syntax_t), intent(out), target :: syntax
type(ifile_t), intent(in) :: ifile
end subroutine syntax_init_from_ifile
end interface
end module syntax_rules
submodule (syntax_rules) syntax_rules_s
use ifiles, only: line_p
implicit none
contains
!!! Intel 21.7 Regression
module subroutine syntax_init_from_ifile (syntax, ifile)
type(syntax_t), intent(out), target :: syntax
type(ifile_t), intent(in) :: ifile
end subroutine syntax_init_from_ifile
end submodule syntax_rules_s
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
The workaround would be to insert also in the submodule the use statement:
use ifile, only: ifile_t
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Thank you for reporting issue and the nice reproducers. Hopefully the regression will be resolved soon in an upcoming release.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Hello Intel Support Team members,
Please consider the following additional case also, if you can either as a separate issue or as an addendum to the incident you may file to follow up on the original post.
Ostensibly it's just a further stripped down version of the smaller reproducer from OP but it may be a separate issue, Intel teams will know best on that. Please note the following:
- Comment out the lines marked A and B in this reduced case and the compiler does not raise any errors. Intel team(s) may perhaps then want to look into how compiler handles the semantics with the PRIVATE statements?
- IFX raises the same errors as IFORT, so perhaps this is a front-end issue?
module m
type :: a_t
end type
type :: b_t
end type
end module
module n
use m, only : a_t, b_t
private !<-- note this statement, call it A
type, public :: n_t
type(a_t), pointer :: a
type(b_t), pointer :: b
end type
end module
module o
use m, only : a_t
use n
private !<-- note this statement, call it B
interface
module subroutine sub( a )
type(a_t), intent(in) :: a
end subroutine
end interface
end module
submodule(o) so
use m, only : b_t
contains
module subroutine sub( a )
type(a_t), intent(in) :: a
end subroutine
end submodule
C:\temp>ifort /c /standard-semantics m.f90
Intel(R) Fortran Intel(R) 64 Compiler Classic for applications running on Intel(R) 64, Version 2021.7.0 Build 20220726_000000
Copyright (C) 1985-2022 Intel Corporation. All rights reserved.
m.f90(29): error #6457: This derived type name has not been declared. [A_T]
type(a_t), intent(in) :: a
-----------^
m.f90(28): error #7257: The characteristics of the procedure argument differ from those specified in the separate interface body. [A]
module subroutine sub( a )
--------------------------^
compilation aborted for m.f90 (code 1)
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
This is the regression in the latest ifort 2021.7 and ifx 2022.2. There is no error with 2021.6 and 2022.1 compiler versions. It is escalated to the developers and should be corrected in the upcoming compiler versions. Thank you for reporting it.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Thanks for escalating it to the development team. I marked it as solution (though, of course, it is solved only when the regression is fixed.
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page