[Bug fortran/38602] New: run time error (crash) - optional arguments, generics, interface problem, iso_varying_string ??

[Bug fortran/38602] New: run time error (crash) - optional arguments, generics, interface problem, iso_varying_string ??

[davidgkinniburgh at yahoo dot co dot uk]

I get a run time error (crashes console) on both my Win64 Vista machine (IA-32)
and WinXP machine on some code that compiles without warnings with gfortran.

Same code compiles and runs OK in g95 and IVF 11.0. 

My test case (below) is calling one of the get() generics from the
iso_varying_string module. It reads a text file ok without the optional set=
argument but crashes when that is included.


gfortran: f951.exe dated 19/12/2008

[components]
runtime=mingwrt-3.15.1-mingw32.tar.gz
w32api=w32api-3.12-mingw32-dev.tar.gz
binutils=binutils-2.17.50-20060824-1.tar.gz
core=gcc-core-3.4.5-20060117-3.tar.gz
gpp=gcc-g++-3.4.5-20060117-3.tar.gz
g77=
ada=
java=
objc=
make=mingw32-make-3.81-20080326-2.tar.gz

==========================================================================

! *****************************************************************
! *                                                               *
! * iso_varying_string.f90                                        *
! *                                                               *
! * Copyright (C) 2003 Rich Townsend <rhdt@star.ucl.ac.uk>        *
! *                                                               *
! * This program is free software; you can redistribute it and/or *
! * modify it under the terms of the GNU Lesser General Public    *
! * License as published by the Free Software Foundation; either  *
! * version 2.1 of the License, or (at your option) any later     *
! * version.                                                      *
! *                                                               *
! * This program is distributed in the hope that it will be       *
! * useful, but WITHOUT ANY WARRANTY; without even the implied    *
! * warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR       *
! * PURPOSE.  See the GNU Lesser General Public License for more  *
! * details.                                                      *
! *                                                               *
! * You should have received a copy of the GNU Lesser General     *
! * Public License along with this program; if not, write to the  *
! * Free Software Foundation, Inc., 59 Temple Place, Suite 330,   *
! * Boston, MA  02111-1307  USA                                   *
! *                                                               *
! *****************************************************************
!
! Developer : Rich Townsend <rhdt@star.ucl.ac.uk>
! Synopsis  : Definition of iso_varying_string module, conformant to 
!             the API specified in ISO/IEC 1539-2:2000 (varying-length 
!             strings for Fortran 95).
! Notes     : This implementation of iso_varying_string is designed to avoid
!             the possibility of memory leaks. To achieve this, it takes
!             advantage of language extensions specified in ISO/IEC
!             TR 15581 (enhanced data type facilities). Many vendors
!             support these extensions, and they will form a core part
!             of Fortran 2000.
! Version   : 1.2
! Thanks    : Lawrie Schonfelder's iso_varying_string module provided me
!             with much insight on how to go about writing this module,
!             for which I am very grateful. Furthermore, Lawrie helped
!             point out some subtle bugs in the module.

module iso_varying_string

! No implicit typing

  implicit none

! Parameter definitions

  integer, parameter :: GET_BUFFER_LEN = 256

! Type definitions

  type varying_string
     private
     character(LEN=1), dimension(:), allocatable :: chars
  end type varying_string

! Interface blocks

  interface assignment(=)
     module procedure op_assign_CH_VS
     module procedure op_assign_VS_CH
  end interface assignment(=)

  interface operator(//)
     module procedure op_concat_VS_VS
     module procedure op_concat_CH_VS
     module procedure op_concat_VS_CH
  end interface operator(//)

  interface operator(==)
     module procedure op_eq_VS_VS
     module procedure op_eq_CH_VS
     module procedure op_eq_VS_CH
  end interface operator(==)

  interface operator(/=)
     module procedure op_ne_VS_VS
     module procedure op_ne_CH_VS
     module procedure op_ne_VS_CH
  end interface operator (/=)

  interface operator(<)
     module procedure op_lt_VS_VS
     module procedure op_lt_CH_VS
     module procedure op_lt_VS_CH
  end interface operator (<)

  interface operator(<=)
     module procedure op_le_VS_VS
     module procedure op_le_CH_VS
     module procedure op_le_VS_CH
  end interface operator (<=)

  interface operator(>=)
     module procedure op_ge_VS_VS
     module procedure op_ge_CH_VS
     module procedure op_ge_VS_CH
  end interface operator (>=)

  interface operator(>)
     module procedure op_gt_VS_VS
     module procedure op_gt_CH_VS
     module procedure op_gt_VS_CH
  end interface operator (>)

  interface adjustl
     module procedure adjustl_
  end interface adjustl

  interface adjustr
     module procedure adjustr_
  end interface adjustr

  interface char
     module procedure char_auto
     module procedure char_fixed
  end interface char

  interface iachar
     module procedure iachar_
  end interface iachar

  interface ichar
     module procedure ichar_
  end interface ichar

  interface index
     module procedure index_VS_VS
     module procedure index_CH_VS
     module procedure index_VS_CH
  end interface index

  interface len
     module procedure len_
  end interface len

  interface len_trim
     module procedure len_trim_
  end interface len_trim

  interface lge
     module procedure lge_VS_VS
     module procedure lge_CH_VS
     module procedure lge_VS_CH
  end interface lge

  interface lgt
     module procedure lgt_VS_VS
     module procedure lgt_CH_VS
     module procedure lgt_VS_CH
  end interface lgt

  interface lle
     module procedure lle_VS_VS
     module procedure lle_CH_VS
     module procedure lle_VS_CH
  end interface lle

  interface llt
     module procedure llt_VS_VS
     module procedure llt_CH_VS
     module procedure llt_VS_CH
  end interface llt

  interface repeat
     module procedure repeat_
  end interface repeat

  interface scan
     module procedure scan_VS_VS
     module procedure scan_CH_VS
     module procedure scan_VS_CH
  end interface scan

  interface trim
     module procedure trim_
  end interface trim

  interface verify
     module procedure verify_VS_VS
     module procedure verify_CH_VS
     module procedure verify_VS_CH
  end interface verify

  interface var_str
     module procedure var_str_
  end interface var_str

  interface get
     module procedure get_
     module procedure get_unit
     module procedure get_set_VS
     module procedure get_set_CH
     module procedure get_unit_set_VS
     module procedure get_unit_set_CH
  end interface get

  interface put
     module procedure put_VS
     module procedure put_CH
     module procedure put_unit_VS
     module procedure put_unit_CH
  end interface put

  interface put_line
     module procedure put_line_VS
     module procedure put_line_CH
     module procedure put_line_unit_VS
     module procedure put_line_unit_CH
  end interface put_line

  interface extract
     module procedure extract_VS
     module procedure extract_CH
  end interface extract

  interface insert
     module procedure insert_VS_VS
     module procedure insert_CH_VS
     module procedure insert_VS_CH
     module procedure insert_CH_CH
  end interface insert

  interface remove
     module procedure remove_VS
     module procedure remove_CH
  end interface remove

  interface replace
     module procedure replace_VS_VS_auto
     module procedure replace_CH_VS_auto
     module procedure replace_VS_CH_auto
     module procedure replace_CH_CH_auto
     module procedure replace_VS_VS_fixed
     module procedure replace_CH_VS_fixed
     module procedure replace_VS_CH_fixed
     module procedure replace_CH_CH_fixed
     module procedure replace_VS_VS_VS_target
     module procedure replace_CH_VS_VS_target
     module procedure replace_VS_CH_VS_target
     module procedure replace_CH_CH_VS_target
     module procedure replace_VS_VS_CH_target
     module procedure replace_CH_VS_CH_target
     module procedure replace_VS_CH_CH_target
     module procedure replace_CH_CH_CH_target
  end interface

  interface split
     module procedure split_VS
     module procedure split_CH
  end interface split

! Access specifiers

  private

  public :: varying_string
  public :: assignment(=)
  public :: operator(//)
  public :: operator(==)
  public :: operator(/=)
  public :: operator(<)
  public :: operator(<=)
  public :: operator(>=)
  public :: operator(>)
  public :: adjustl
  public :: adjustr
  public :: char
  public :: iachar
  public :: ichar
  public :: index
  public :: len
  public :: len_trim
  public :: lge
  public :: lgt
  public :: lle
  public :: llt
  public :: repeat
  public :: scan
  public :: trim
  public :: verify
  public :: var_str
  public :: get
  public :: put
  public :: put_line
  public :: extract
  public :: insert
  public :: remove
  public :: replace
  public :: split

! Procedures

contains

!****

  elemental subroutine op_assign_CH_VS (var, exp)

    character(LEN=*), intent(out)    :: var
    type(varying_string), intent(in) :: exp

! Assign a varying string to a character string

    var = char(exp)

! Finish

    return

  end subroutine op_assign_CH_VS

!****

  elemental subroutine op_assign_VS_CH (var, exp)

    type(varying_string), intent(out) :: var
    character(LEN=*), intent(in)      :: exp

! Assign a character string to a varying string

    var = var_str(exp)

! Finish

    return

  end subroutine op_assign_VS_CH

!****

  elemental function op_concat_VS_VS (string_a, string_b) result
(concat_string)

    type(varying_string), intent(in) :: string_a
    type(varying_string), intent(in) :: string_b
    type(varying_string)             :: concat_string

    integer                          :: len_string_a

! Concatenate two varying strings

    len_string_a = len(string_a)

    ALLOCATE(concat_string%chars(len_string_a+len(string_b)))

    concat_string%chars(:len_string_a) = string_a%chars
    concat_string%chars(len_string_a+1:) = string_b%chars

! Finish

    return

  end function op_concat_VS_VS

!****

  elemental function op_concat_CH_VS (string_a, string_b) result
(concat_string)

    character(LEN=*), intent(in)     :: string_a
    type(varying_string), intent(in) :: string_b
    type(varying_string)             :: concat_string

! Concatenate a character string and a varying 
! string

    concat_string = op_concat_VS_VS(var_str(string_a), string_b)

! Finish

    return

  end function op_concat_CH_VS

!****

  elemental function op_concat_VS_CH (string_a, string_b) result
(concat_string)

    type(varying_string), intent(in) :: string_a
    character(LEN=*), intent(in)     :: string_b
    type(varying_string)             :: concat_string

! Concatenate a varying string and a character
! string

    concat_string = op_concat_VS_VS(string_a, var_str(string_b))

! Finish

    return

  end function op_concat_VS_CH

!****

  elemental function op_eq_VS_VS (string_a, string_b) result (op_eq)

    type(varying_string), intent(in) :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_eq

! Compare (==) two varying strings

    op_eq = char(string_a) == char(string_b)

! Finish

    return

  end function op_eq_VS_VS

!****

  elemental function op_eq_CH_VS (string_a, string_b) result (op_eq)

    character(LEN=*), intent(in)     :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_eq

! Compare (==) a character string and a varying 
! string

    op_eq = string_a == char(string_b)

! Finish

    return

  end function op_eq_CH_VS

!****

  elemental function op_eq_VS_CH (string_a, string_b) result (op_eq)

    type(varying_string), intent(in) :: string_a
    character(LEN=*), intent(in)     :: string_b
    logical                          :: op_eq

! Compare (==) a varying string and a character
! string

    op_eq = char(string_a) == string_b

! Finish

    return

  end function op_eq_VS_CH

!****

  elemental function op_ne_VS_VS (string_a, string_b) result (op_ne)

    type(varying_string), intent(in) :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_ne

! Compare (/=) two varying strings

    op_ne = char(string_a) /= char(string_b)

! Finish

    return

  end function op_ne_VS_VS

!****

  elemental function op_ne_CH_VS (string_a, string_b) result (op_ne)

    character(LEN=*), intent(in)     :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_ne

! Compare (/=) a character string and a varying
! string

    op_ne = string_a /= char(string_b)

! Finish

    return

  end function op_ne_CH_VS

!****

  elemental function op_ne_VS_CH (string_a, string_b) result (op_ne)

    type(varying_string), intent(in) :: string_a
    character(LEN=*), intent(in)     :: string_b
    logical                          :: op_ne

! Compare (/=) a varying string and a character
! string

    op_ne = char(string_a) /= string_b

! Finish

    return

  end function op_ne_VS_CH

!****

  elemental function op_lt_VS_VS (string_a, string_b) result (op_lt)

    type(varying_string), intent(in) :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_lt

! Compare (<) two varying strings

    op_lt = char(string_a) < char(string_b)

! Finish

    return

  end function op_lt_VS_VS

!****

  elemental function op_lt_CH_VS (string_a, string_b) result (op_lt)

    character(LEN=*), intent(in)     :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_lt

! Compare (<) a character string and a varying
! string

    op_lt = string_a < char(string_b)

! Finish

    return

  end function op_lt_CH_VS

!****

  elemental function op_lt_VS_CH (string_a, string_b) result (op_lt)

    type(varying_string), intent(in) :: string_a
    character(LEN=*), intent(in)     :: string_b
    logical                          :: op_lt

! Compare (<) a varying string and a character 
! string

    op_lt = char(string_a) < string_b

! Finish

    return

  end function op_lt_VS_CH

!****

  elemental function op_le_VS_VS (string_a, string_b) result (op_le)

    type(varying_string), intent(in) :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_le

! Compare (<=) two varying strings

    op_le = char(string_a) <= char(string_b)

! Finish

    return

  end function op_le_VS_VS

!****

  elemental function op_le_CH_VS (string_a, string_b) result (op_le)

    character(LEN=*), intent(in)     :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_le

! Compare (<=) a character string and a varying 
! string

    op_le = string_a <= char(string_b)

! Finish

    return

  end function op_le_CH_VS

!****

  elemental function op_le_VS_CH (string_a, string_b) result (op_le)

    type(varying_string), intent(in) :: string_a
    character(LEN=*), intent(in)     :: string_b
    logical                          :: op_le

! Compare (<=) a varying string and a character 
! string

    op_le = char(string_a) <= string_b

! Finish

    return

  end function op_le_VS_CH

!****

  elemental function op_ge_VS_VS (string_a, string_b) result (op_ge)

    type(varying_string), intent(in) :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_ge

! Compare (>=) two varying strings

    op_ge = char(string_a) >= char(string_b)

! Finish

    return

  end function op_ge_VS_VS

!****

  elemental function op_ge_CH_VS (string_a, string_b) result (op_ge)

    character(LEN=*), intent(in)     :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_ge

! Compare (>=) a character string and a varying
! string

    op_ge = string_a >= char(string_b)

! Finish

    return

  end function op_ge_CH_VS

!****

  elemental function op_ge_VS_CH (string_a, string_b) result (op_ge)

    type(varying_string), intent(in) :: string_a
    character(LEN=*), intent(in)     :: string_b
    logical                          :: op_ge

! Compare (>=) a varying string and a character
! string

    op_ge = char(string_a) >= string_b

! Finish

    return

  end function op_ge_VS_CH

!****

  elemental function op_gt_VS_VS (string_a, string_b) result (op_gt)

    type(varying_string), intent(in) :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_gt

! Compare (>) two varying strings

    op_gt = char(string_a) > char(string_b)

! Finish

    return

  end function op_gt_VS_VS

!****

  elemental function op_gt_CH_VS (string_a, string_b) result (op_gt)

    character(LEN=*), intent(in)     :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_gt

! Compare (>) a character string and a varying
! string

    op_gt = string_a > char(string_b)

! Finish

    return

  end function op_gt_CH_VS

!****

  elemental function op_gt_VS_CH (string_a, string_b) result (op_gt)

    type(varying_string), intent(in) :: string_a
    character(LEN=*), intent(in)     :: string_b
    logical                          :: op_gt

! Compare (>) a varying string and a character
! string

    op_gt = char(string_a) > string_b

! Finish

    return

  end function op_gt_VS_CH

!****

  elemental function adjustl_ (string) result (adjustl_string)

    type(varying_string), intent(in) :: string
    type(varying_string)             :: adjustl_string

! Adjust the varying string to the left

    adjustl_string = ADJUSTL(CHAR(string))

! Finish

    return

  end function adjustl_

!****

  elemental function adjustr_ (string) result (adjustr_string)

    type(varying_string), intent(in) :: string
    type(varying_string)             :: adjustr_string

! Adjust the varying string to the right

    adjustr_string = ADJUSTR(CHAR(string))

! Finish

    return

  end function adjustr_

!****

  pure function char_auto (string) result (char_string)

    type(varying_string), intent(in) :: string
    character(LEN=len(string))       :: char_string

    integer                          :: i_char

! Convert a varying string into a character string
! (automatic length)

    forall(i_char = 1:len(string))
       char_string(i_char:i_char) = string%chars(i_char)
    end forall

! Finish

    return

  end function char_auto

!****

  pure function char_fixed (string, length) result (char_string)

    type(varying_string), intent(in) :: string
    integer, intent(in)              :: length
    character(LEN=length)            :: char_string

! Convert a varying string into a character string
! (fixed length)

    char_string = char(string)

! Finish

    return

  end function char_fixed

!****

  elemental function iachar_ (c) result (i)

    type(varying_string), intent(in) :: c
    integer                          :: i

! Get the position in the ISO 646 collating sequence
! of a varying string character

    i = IACHAR(char(c))

! Finish

    return

  end function iachar_

!****

  elemental function ichar_ (c) result (i)

    type(varying_string), intent(in) :: c
    integer                          :: i

! Get the position in the processor collating 
! sequence of a varying string character

    i = ICHAR(char(c))

! Finish

    return

  end function ichar_

!****

  elemental function index_VS_VS (string, substring, back) result (i_substring)

    type(varying_string), intent(in) :: string
    type(varying_string), intent(in) :: substring
    logical, intent(in), optional    :: back
    integer                          :: i_substring

! Get the index of a varying substring within a
! varying string

    i_substring = INDEX(char(string), char(substring), back)

! Finish

    return

  end function index_VS_VS

!****

  elemental function index_CH_VS (string, substring, back) result (i_substring)

    character(LEN=*), intent(in)     :: string
    type(varying_string), intent(in) :: substring
    logical, intent(in), optional    :: back
    integer                          :: i_substring

! Get the index of a varying substring within a
! character string

    i_substring = INDEX(string, char(substring), back)

! Finish

    return

  end function index_CH_VS

!****

  elemental function index_VS_CH (string, substring, back) result (i_substring)

    type(varying_string), intent(in) :: string
    character(LEN=*), intent(in)     :: substring
    logical, intent(in), optional    :: back
    integer                          :: i_substring

! Get the index of a character substring within a
! varying string

    i_substring = INDEX(char(string), substring, back)

! Finish

    return

  end function index_VS_CH

!****

  elemental function len_ (string) result (length)

    type(varying_string), intent(in) :: string
    integer                          :: length

! Get the length of a varying string

    if(ALLOCATED(string%chars)) then
       length = SIZE(string%chars)
    else
       length = 0
    endif

! Finish

    return

  end function len_

!****

  elemental function len_trim_ (string) result (length)

    type(varying_string), intent(in) :: string
    integer                          :: length

! Get the trimmed length of a varying string

    if(ALLOCATED(string%chars)) then
       length = LEN_TRIM(char(string))
    else
       length = 0
    endif

! Finish

    return

  end function len_trim_

!****

  elemental function lge_VS_VS (string_a, string_b) result (comp)

    type(varying_string), intent(in) :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: comp

! Compare (LGE) two varying strings

    comp = LGE(char(string_a), char(string_b))

! Finish

    return

  end function lge_VS_VS

!****

  elemental function lge_CH_VS (string_a, string_b) result (comp)

    character(LEN=*), intent(in)     :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: comp

! Compare (LGE) a character string and a varying
! string

    comp = LGE(string_a, char(string_b))

! Finish

    return

  end function lge_CH_VS

!****

  elemental function lge_VS_CH (string_a, string_b) result (comp)

    type(varying_string), intent(in) :: string_a
    character(LEN=*), intent(in)     :: string_b
    logical                          :: comp

! Compare (LGE) a varying string and a character
! string

    comp = LGE(char(string_a), string_b)

! Finish

    return

  end function lge_VS_CH

!****

  elemental function lgt_VS_VS (string_a, string_b) result (comp)

    type(varying_string), intent(in) :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: comp

! Compare (LGT) two varying strings

    comp = LGT(char(string_a), char(string_b))

! Finish

    return

  end function lgt_VS_VS

!****

  elemental function lgt_CH_VS (string_a, string_b) result (comp)

    character(LEN=*), intent(in)     :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: comp

! Compare (LGT) a character string and a varying
! string

    comp = LGT(string_a, char(string_b))

! Finish

    return

  end function lgt_CH_VS

!****

  elemental function lgt_VS_CH (string_a, string_b) result (comp)

    type(varying_string), intent(in) :: string_a
    character(LEN=*), intent(in)     :: string_b
    logical                          :: comp

! Compare (LGT) a varying string and a character
! string

    comp = LGT(char(string_a), string_b)

! Finish

    return

  end function lgt_VS_CH

!****

  elemental function lle_VS_VS (string_a, string_b) result (comp)

    type(varying_string), intent(in) :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: comp

! Compare (LLE) two varying strings

    comp = LLE(char(string_a), char(string_b))

! Finish

    return

  end function lle_VS_VS

!****

  elemental function lle_CH_VS (string_a, string_b) result (comp)

    character(LEN=*), intent(in)     :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: comp

! Compare (LLE) a character string and a varying
! string

    comp = LLE(string_a, char(string_b))

! Finish

    return

  end function lle_CH_VS

!****

  elemental function lle_VS_CH (string_a, string_b) result (comp)

    type(varying_string), intent(in) :: string_a
    character(LEN=*), intent(in)     :: string_b
    logical                          :: comp

! Compare (LLE) a varying string and a character
! string

    comp = LLE(char(string_a), string_b)

! Finish

    return

  end function lle_VS_CH

!****

  elemental function llt_VS_VS (string_a, string_b) result (comp)

    type(varying_string), intent(in) :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: comp

! Compare (LLT) two varying strings

    comp = LLT(char(string_a), char(string_b))

! Finish

    return

  end function llt_VS_VS

!****

  elemental function llt_CH_VS (string_a, string_b) result (comp)

    character(LEN=*), intent(in)     :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: comp

! Compare (LLT) a character string and a varying
! string

    comp = LLT(string_a, char(string_b))

! Finish

    return

  end function llt_CH_VS

!****

  elemental function llt_VS_CH (string_a, string_b) result (comp)

    type(varying_string), intent(in) :: string_a
    character(LEN=*), intent(in)     :: string_b
    logical                          :: comp

! Compare (LLT) a varying string and a character
! string

    comp = LLT(char(string_a), string_b)

! Finish

    return

  end function llt_VS_CH

!****

  elemental function repeat_ (string, ncopies) result (repeat_string)

    type(varying_string), intent(in) :: string
    integer, intent(in)              :: ncopies
    type(varying_string)             :: repeat_string

! Concatenate several copies of a varying string

    repeat_string = var_str(REPEAT(char(string), ncopies))

! Finish

    return

  end function repeat_

!****

  elemental function scan_VS_VS (string, set, back) result (i)

    type(varying_string), intent(in) :: string
    type(varying_string), intent(in) :: set
    logical, intent(in), optional    :: back
    integer                          :: i

! Scan a varying string for occurrences of 
! characters in a varying-string set

    i = SCAN(char(string), char(set), back)

! Finish

    return

  end function scan_VS_VS

!****

  elemental function scan_CH_VS (string, set, back) result (i)

    character(LEN=*), intent(in)     :: string
    type(varying_string), intent(in) :: set
    logical, intent(in), optional    :: back
    integer                          :: i

! Scan a character string for occurrences of 
! characters in a varying-string set

    i = SCAN(string, char(set), back)

! Finish

    return

  end function scan_CH_VS

!****

  elemental function scan_VS_CH (string, set, back) result (i)

    type(varying_string), intent(in) :: string
    character(LEN=*), intent(in)     :: set
    logical, intent(in), optional    :: back
    integer                          :: i

! Scan a varying string for occurrences of 
! characters in a character-string set

    i = SCAN(char(string), set, back)

! Finish

    return

  end function scan_VS_CH

!****

  elemental function trim_ (string) result (trim_string)

    type(varying_string), intent(in) :: string
    type(varying_string)             :: trim_string

! Remove trailing blanks from a varying string

    trim_string = TRIM(char(string))

! Finish

    return

  end function trim_

!****

  elemental function verify_VS_VS (string, set, back) result (i)

    type(varying_string), intent(in) :: string
    type(varying_string), intent(in) :: set
    logical, intent(in), optional    :: back
    integer                          :: i

! Verify a varying string for occurrences of
! characters in a varying-string set

    i = VERIFY(char(string), char(set), back)

! Finish

    return

  end function verify_VS_VS

!****

  elemental function verify_CH_VS (string, set, back) result (i)

    character(LEN=*), intent(in)     :: string
    type(varying_string), intent(in) :: set
    logical, intent(in), optional    :: back
    integer                          :: i

! Verify a character string for occurrences of 
! characters in a varying-string set

    i = VERIFY(string, char(set), back)

! Finish

    return

  end function verify_CH_VS

!****

  elemental function verify_VS_CH (string, set, back) result (i)

    type(varying_string), intent(in) :: string
    character(LEN=*), intent(in)     :: set
    logical, intent(in), optional    :: back
    integer                          :: i

! Verify a varying string for occurrences of 
! characters in a character-string set

    i = VERIFY(char(string), set, back)

! Finish

    return

  end function verify_VS_CH

!****

  elemental function var_str_ (char) result (string)

    character(LEN=*), intent(in) :: char
    type(varying_string)         :: string

    integer                      :: length
    integer                      :: i_char

! Convert a character string to a varying string

    length = LEN(char)

    ALLOCATE(string%chars(length))

    forall(i_char = 1:length)
       string%chars(i_char) = char(i_char:i_char)
    end forall

! Finish

    return

  end function var_str_

!****

  subroutine get_ (string, maxlen, iostat)

    type(varying_string), intent(out) :: string
    integer, intent(in), optional     :: maxlen
    integer, intent(out), optional    :: iostat

    integer                           :: n_chars_remain
    integer                           :: n_chars_read
    character(LEN=GET_BUFFER_LEN)     :: buffer

! Read from the default unit into a varying string

    string = ''

    if(PRESENT(maxlen)) then
       n_chars_remain = maxlen
    else
       n_chars_remain = HUGE(1)
    endif

    read_loop : do

       if(n_chars_remain <= 0) return

       n_chars_read = MIN(n_chars_remain, GET_BUFFER_LEN)

       if(PRESENT(iostat)) then
          read(*, FMT='(A)', ADVANCE='NO', IOSTAT=iostat, SIZE=n_chars_read)
buffer(:n_chars_read)
          if(iostat < 0) exit read_loop
          if(iostat > 0) return
       else
          read(*, FMT='(A)', ADVANCE='NO', EOR=999, SIZE=n_chars_read)
buffer(:n_chars_read)
       endif

       string = string//buffer(:n_chars_read)
       n_chars_remain = n_chars_remain - n_chars_read

    end do read_loop

999 continue

    string = string//buffer(:n_chars_read)

! Finish (end-of-record)

    return

  end subroutine get_

!****

  subroutine get_unit (unit, string, maxlen, iostat)

    integer, intent(in)               :: unit
    type(varying_string), intent(out) :: string
    integer, intent(in), optional     :: maxlen
    integer, intent(out), optional    :: iostat

    integer                           :: n_chars_remain
    integer                           :: n_chars_read
    character(LEN=GET_BUFFER_LEN)     :: buffer

! Read from the specified unit into a varying string

    string = ''

    if(PRESENT(maxlen)) then
       n_chars_remain = maxlen
    else
       n_chars_remain = HUGE(1)
    endif

    read_loop : do

       if(n_chars_remain <= 0) return

       n_chars_read = MIN(n_chars_remain, GET_BUFFER_LEN)

       if(PRESENT(iostat)) then
          read(unit, FMT='(A)', ADVANCE='NO', IOSTAT=iostat, SIZE=n_chars_read)
buffer(:n_chars_read)
          if(iostat < 0) exit read_loop
          if(iostat > 0) return
       else
          read(unit, FMT='(A)', ADVANCE='NO', EOR=999, SIZE=n_chars_read)
buffer(:n_chars_read)
       endif

       string = string//buffer(:n_chars_read)
       n_chars_remain = n_chars_remain - n_chars_read

    end do read_loop

999 continue

    string = string//buffer(:n_chars_read)

! Finish (end-of-record)

    return

  end subroutine get_unit

!****

  subroutine get_set_VS (string, set, separator, maxlen, iostat)

    type(varying_string), intent(out)           :: string
    type(varying_string), intent(in)            :: set
    type(varying_string), intent(out), optional :: separator
    integer, intent(in), optional               :: maxlen
    integer, intent(out), optional              :: iostat

! Read from the default unit into a varying string,
! with a custom varying-string separator

    call get(string, char(set), separator, maxlen, iostat)

! Finish

    return

  end subroutine get_set_VS

!****

  subroutine get_set_CH (string, set, separator, maxlen, iostat)

    type(varying_string), intent(out)           :: string
    character(LEN=*), intent(in)                :: set
    type(varying_string), intent(out), optional :: separator
    integer, intent(in), optional               :: maxlen
    integer, intent(out), optional              :: iostat

    integer                                     :: n_chars_remain
    character(LEN=1)                            :: buffer
    integer                                     :: i_set

! Read from the default unit into a varying string,
! with a custom character-string separator

    string = ''

    if(PRESENT(maxlen)) then
       n_chars_remain = maxlen
    else
       n_chars_remain = HUGE(1)
    endif

    if(PRESENT(separator)) separator = ''

    read_loop : do

       if(n_chars_remain <= 0) return

       if(PRESENT(iostat)) then
          read(*, FMT='(A1)', ADVANCE='NO', IOSTAT=iostat) buffer
          if(iostat /= 0) exit read_loop
       else
          read(*, FMT='(A1)', ADVANCE='NO', EOR=999) buffer
       endif

       i_set = SCAN(buffer, set)

       if(i_set == 1) then
          if(PRESENT(separator)) separator = buffer
          exit read_loop
       endif

       string = string//buffer
       n_chars_remain = n_chars_remain - 1

    end do read_loop

999 continue

! Finish

    return

  end subroutine get_set_CH

!****

  subroutine get_unit_set_VS (unit, string, set, separator, maxlen, iostat)

    integer, intent(in)                         :: unit
    type(varying_string), intent(out)           :: string
    type(varying_string), intent(in)            :: set
    type(varying_string), intent(out), optional :: separator
    integer, intent(in), optional               :: maxlen
    integer, intent(out), optional              :: iostat

! Read from the specified unit into a varying string,
! with a custom varying-string separator

    call get(unit, string, char(set), separator, maxlen, iostat)

! Finish

    return

  end subroutine get_unit_set_VS

!****

  subroutine get_unit_set_CH (unit, string, set, separator, maxlen, iostat)

    integer, intent(in)                         :: unit
    type(varying_string), intent(out)           :: string
    character(LEN=*), intent(in)                :: set
    type(varying_string), intent(out), optional :: separator
    integer, intent(in), optional               :: maxlen
    integer, intent(out), optional              :: iostat

    integer                                     :: n_chars_remain
    character(LEN=1)                            :: buffer
    integer                                     :: i_set

! Read from the default unit into a varying string,
! with a custom character-string separator

    string = ''

    if(PRESENT(maxlen)) then
       n_chars_remain = maxlen
    else
       n_chars_remain = HUGE(1)
    endif

    if(PRESENT(separator)) separator = ''

    read_loop : do

       if(n_chars_remain <= 0) return

       if(PRESENT(iostat)) then
          read(unit, FMT='(A1)', ADVANCE='NO', IOSTAT=iostat) buffer
          if(iostat /= 0) exit read_loop
       else
          read(unit, FMT='(A1)', ADVANCE='NO', EOR=999) buffer
       endif

       i_set = SCAN(buffer, set)

       if(i_set == 1) then
          if(PRESENT(separator)) separator = buffer
          exit read_loop
       endif

       string = string//buffer
       n_chars_remain = n_chars_remain - 1

    end do read_loop

999 continue

! Finish

    return

  end subroutine get_unit_set_CH

!****

  subroutine put_VS (string, iostat)

    type(varying_string), intent(in) :: string
    integer, intent(out), optional   :: iostat

! Append a varying string to the current record of 
! the default unit

    call put(char(string), iostat)

! Finish

  end subroutine put_VS

!****

  subroutine put_CH (string, iostat)

    character(LEN=*), intent(in)   :: string
    integer, intent(out), optional :: iostat

! Append a character string to the current record of 
! the default unit

    if(PRESENT(iostat)) then
       write(*, FMT='(A)', ADVANCE='NO', IOSTAT=iostat) string
    else
       write(*, FMT='(A)', ADVANCE='NO') string
    endif

! Finish

  end subroutine put_CH

!****

  subroutine put_unit_VS (unit, string, iostat)

    integer, intent(in)              :: unit
    type(varying_string), intent(in) :: string
    integer, intent(out), optional   :: iostat

! Append a varying string to the current record of 
! the specified unit

    call put(unit, char(string), iostat)

! Finish

    return

  end subroutine put_unit_VS

!****

  subroutine put_unit_CH (unit, string, iostat)

    integer, intent(in)            :: unit
    character(LEN=*), intent(in)   :: string
    integer, intent(out), optional :: iostat

! Append a character string to the current record of 
! the specified unit

    if(PRESENT(iostat)) then
       write(unit, FMT='(A)', ADVANCE='NO', IOSTAT=iostat) string
    else
       write(unit, FMT='(A)', ADVANCE='NO') string
    endif

! Finish

    return

  end subroutine put_unit_CH

!****

  subroutine put_line_VS (string, iostat)

    type(varying_string), intent(in) :: string
    integer, intent(out), optional   :: iostat

! Append a varying string to the current record of 
! the default unit, terminating the record

    call put_line(char(string), iostat)

! Finish

    return

  end subroutine put_line_VS

!****

  subroutine put_line_CH (string, iostat)

    character(LEN=*), intent(in)   :: string
    integer, intent(out), optional :: iostat

! Append a varying string to the current record of 
! the default unit, terminating the record

    if(PRESENT(iostat)) then
       write(*, FMT='(A,/)', ADVANCE='NO', IOSTAT=iostat) string
    else
       write(*, FMT='(A,/)', ADVANCE='NO') string
    endif

! Finish

    return

  end subroutine put_line_CH

!****

  subroutine put_line_unit_VS (unit, string, iostat)

    integer, intent(in)              :: unit
    type(varying_string), intent(in) :: string
    integer, intent(out), optional   :: iostat

! Append a varying string to the current record of 
! the specified unit, terminating the record

    call put_line(unit, char(string), iostat)

! Finish

    return

  end subroutine put_line_unit_VS

!****

  subroutine put_line_unit_CH (unit, string, iostat)

    integer, intent(in)            :: unit
    character(LEN=*), intent(in)   :: string
    integer, intent(out), optional :: iostat

! Append a varying string to the current record of 
! the specified unit, terminating the record

    if(PRESENT(iostat)) then
       write(unit, FMT='(A,/)', ADVANCE='NO', IOSTAT=iostat) string
    else
       write(unit, FMT='(A,/)', ADVANCE='NO') string
    endif

! Finish

    return

  end subroutine put_line_unit_CH

!****

  elemental function extract_VS (string, start, finish) result (ext_string)

    type(varying_string), intent(in) :: string
    integer, intent(in), optional    :: start
    integer, intent(in), optional    :: finish
    type(varying_string)             :: ext_string

! Extract a varying substring from a varying string

    ext_string = extract(char(string), start, finish)

! Finish

    return

  end function extract_VS

!****

  elemental function extract_CH (string, start, finish) result (ext_string)

    character(LEN=*), intent(in)  :: string
    integer, intent(in), optional :: start
    integer, intent(in), optional :: finish
    type(varying_string)          :: ext_string

    integer                       :: start_
    integer                       :: finish_

! Extract a varying substring from a character string

    if(PRESENT(start)) then
       start_ = MAX(1, start)
    else
       start_ = 1
    endif

    if(PRESENT(finish)) then
       finish_ = MIN(LEN(string), finish)
    else
       finish_ = LEN(string)
    endif

    ext_string = var_str(string(start_:finish_))

! Finish

    return

  end function extract_CH

!****

  elemental function insert_VS_VS (string, start, substring) result
(ins_string)

    type(varying_string), intent(in) :: string
    integer, intent(in)              :: start
    type(varying_string), intent(in) :: substring
    type(varying_string)             :: ins_string

! Insert a varying substring into a varying string

    ins_string = insert(char(string), start, char(substring))

! Finish

    return

  end function insert_VS_VS

!****

  elemental function insert_CH_VS (string, start, substring) result
(ins_string)

    character(LEN=*), intent(in)     :: string
    integer, intent(in)              :: start
    type(varying_string), intent(in) :: substring
    type(varying_string)             :: ins_string

! Insert a varying substring into a character string

    ins_string = insert(string, start, char(substring))

! Finish

    return

  end function insert_CH_VS

!****

  elemental function insert_VS_CH (string, start, substring) result
(ins_string)

    type(varying_string), intent(in) :: string
    integer, intent(in)              :: start
    character(LEN=*), intent(in)     :: substring
    type(varying_string)             :: ins_string

! Insert a character substring into a varying string

    ins_string = insert(char(string), start, substring)

! Finish

    return

  end function insert_VS_CH

!****

  elemental function insert_CH_CH (string, start, substring) result
(ins_string)

    character(LEN=*), intent(in) :: string
    integer, intent(in)          :: start
    character(LEN=*), intent(in) :: substring
    type(varying_string)         :: ins_string

    integer                      :: start_

! Insert a character substring into a character
! string

    start_ = MAX(1, MIN(start, LEN(string)+1))

    ins_string = var_str(string(:start_-1)//substring//string(start_:))

! Finish

    return

  end function insert_CH_CH

!****

  elemental function remove_VS (string, start, finish) result (rem_string)

    type(varying_string), intent(in) :: string
    integer, intent(in), optional    :: start
    integer, intent(in), optional    :: finish
    type(varying_string)             :: rem_string

! Remove a substring from a varying string

    rem_string = remove(char(string), start, finish)

! Finish

    return

  end function remove_VS

!****

  elemental function remove_CH (string, start, finish) result (rem_string)

    character(LEN=*), intent(in)  :: string
    integer, intent(in), optional :: start
    integer, intent(in), optional :: finish
    type(varying_string)          :: rem_string

    integer                       :: start_
    integer                       :: finish_

! Remove a substring from a character string

    if(PRESENT(start)) then
       start_ = MAX(1, start)
    else
       start_ = 1
    endif

    if(PRESENT(finish)) then
       finish_ = MIN(LEN(string), finish)
    else
       finish_ = LEN(string)
    endif

    if(finish_ >= start_) then
       rem_string = var_str(string(:start_-1)//string(finish_+1:))
    else
       rem_string = string
    endif

! Finish

    return

  end function remove_CH

!****

  elemental function replace_VS_VS_auto (string, start, substring) result
(rep_string)

    type(varying_string), intent(in) :: string
    integer, intent(in)              :: start
    type(varying_string), intent(in) :: substring
    type(varying_string)             :: rep_string

! Replace part of a varying string with a varying
! substring

    rep_string = replace(char(string), start, MAX(start, 1)+len(substring)-1,
char(substring))

! Finish

    return

  end function replace_VS_VS_auto

!****

  elemental function replace_CH_VS_auto (string, start, substring) result
(rep_string)

    character(LEN=*), intent(in)     :: string
    integer, intent(in)              :: start
    type(varying_string), intent(in) :: substring
    type(varying_string)             :: rep_string

! Replace part of a character string with a varying
! substring

    rep_string = replace(string, start, MAX(start, 1)+len(substring)-1,
char(substring))

! Finish

    return

  end function replace_CH_VS_auto

!****

  elemental function replace_VS_CH_auto (string, start, substring) result
(rep_string)

    type(varying_string), intent(in) :: string
    integer, intent(in)              :: start
    character(LEN=*), intent(in)     :: substring
    type(varying_string)             :: rep_string

! Replace part of a varying string with a character
! substring

    rep_string = replace(char(string), start, MAX(start, 1)+LEN(substring)-1,
substring)

! Finish

    return

  end function replace_VS_CH_auto

!****

  elemental function replace_CH_CH_auto (string, start, substring) result
(rep_string)

    character(LEN=*), intent(in) :: string
    integer, intent(in)          :: start
    character(LEN=*), intent(in) :: substring
    type(varying_string)         :: rep_string

! Replace part of a character string with a character
! substring

    rep_string = replace(string, start, MAX(start, 1)+LEN(substring)-1,
substring)

! Finish

    return

  end function replace_CH_CH_auto

!****

  elemental function replace_VS_VS_fixed (string, start, finish, substring)
result (rep_string)

    type(varying_string), intent(in) :: string
    integer, intent(in)              :: start
    integer, intent(in)              :: finish
    type(varying_string), intent(in) :: substring
    type(varying_string)             :: rep_string

! Replace part of a varying string with a varying
! substring

    rep_string = replace(char(string), start, finish, char(substring))

! Finish

    return

  end function replace_VS_VS_fixed

!****

!****

  elemental function replace_CH_VS_fixed (string, start, finish, substring)
result (rep_string)

    character(LEN=*), intent(in)     :: string
    integer, intent(in)              :: start
    integer, intent(in)              :: finish
    type(varying_string), intent(in) :: substring
    type(varying_string)             :: rep_string

! Replace part of a character string with a varying
! substring

    rep_string = replace(string, start, finish, char(substring))

! Finish

    return

  end function replace_CH_VS_fixed

!****

  elemental function replace_VS_CH_fixed (string, start, finish, substring)
result (rep_string)

    type(varying_string), intent(in) :: string
    integer, intent(in)              :: start
    integer, intent(in)              :: finish
    character(LEN=*), intent(in)     :: substring
    type(varying_string)             :: rep_string

! Replace part of a varying string with a character
! substring

    rep_string = replace(char(string), start, finish, substring)

! Finish

    return

  end function replace_VS_CH_fixed

!****

  elemental function replace_CH_CH_fixed (string, start, finish, substring)
result (rep_string)

    character(LEN=*), intent(in) :: string
    integer, intent(in)          :: start
    integer, intent(in)          :: finish
    character(LEN=*), intent(in) :: substring
    type(varying_string)         :: rep_string

    integer                      :: start_
    integer                      :: finish_

! Replace part of a character string with a character
! substring

    start_ = MAX(1, start)
    finish_ = MIN(LEN(string), finish)

    if(finish_ < start_) then
       rep_string = insert(string, start_, substring)
    else
       rep_string = var_str(string(:start_-1)//substring//string(finish_+1:))
    endif

! Finish

    return

  end function replace_CH_CH_fixed

!****

  elemental function replace_VS_VS_VS_target (string, target, substring, every,
back) result (rep_string)

    type(varying_string), intent(in) :: string
    type(varying_string), intent(in) :: target
    type(varying_string), intent(in) :: substring
    logical, intent(in), optional    :: every
    logical, intent(in), optional    :: back
    type(varying_string)             :: rep_string

! Replace part of a varying string with a varying
! substring, at a location matching a varying-
! string target

    rep_string = replace(char(string), char(target), char(substring), every,
back)

! Finish

    return

  end function replace_VS_VS_VS_target

!****

  elemental function replace_CH_VS_VS_target (string, target, substring, every,
back) result (rep_string)

    character(LEN=*), intent(in)     :: string
    type(varying_string), intent(in) :: target
    type(varying_string), intent(in) :: substring
    logical, intent(in), optional    :: every
    logical, intent(in), optional    :: back
    type(varying_string)             :: rep_string

! Replace part of a character string with a varying
! substring, at a location matching a varying-
! string target

    rep_string = replace(string, char(target), char(substring), every, back)

! Finish

    return

  end function replace_CH_VS_VS_target

!****

  elemental function replace_VS_CH_VS_target (string, target, substring, every,
back) result (rep_string)

    type(varying_string), intent(in) :: string
    character(LEN=*), intent(in)     :: target
    type(varying_string), intent(in) :: substring
    logical, intent(in), optional    :: every
    logical, intent(in), optional    :: back
    type(varying_string)             :: rep_string

! Replace part of a character string with a varying
! substring, at a location matching a character-
! string target

    rep_string = replace(char(string), target, char(substring), every, back)

! Finish

    return

  end function replace_VS_CH_VS_target

!****

  elemental function replace_CH_CH_VS_target (string, target, substring, every,
back) result (rep_string)

    character(LEN=*), intent(in)     :: string
    character(LEN=*), intent(in)     :: target
    type(varying_string), intent(in) :: substring
    logical, intent(in), optional    :: every
    logical, intent(in), optional    :: back
    type(varying_string)             :: rep_string

! Replace part of a character string with a varying
! substring, at a location matching a character-
! string target

    rep_string = replace(string, target, char(substring), every, back)

! Finish

    return

  end function replace_CH_CH_VS_target

!****

  elemental function replace_VS_VS_CH_target (string, target, substring, every,
back) result (rep_string)

    type(varying_string), intent(in) :: string
    type(varying_string), intent(in) :: target
    character(LEN=*), intent(in)     :: substring
    logical, intent(in), optional    :: every
    logical, intent(in), optional    :: back
    type(varying_string)             :: rep_string

! Replace part of a varying string with a character
! substring, at a location matching a varying-
! string target

    rep_string = replace(char(string), char(target), substring, every, back)

! Finish

    return

  end function replace_VS_VS_CH_target

!****

  elemental function replace_CH_VS_CH_target (string, target, substring, every,
back) result (rep_string)

    character(LEN=*), intent(in)     :: string
    type(varying_string), intent(in) :: target
    character(LEN=*), intent(in)     :: substring
    logical, intent(in), optional    :: every
    logical, intent(in), optional    :: back
    type(varying_string)             :: rep_string

! Replace part of a character string with a character
! substring, at a location matching a varying-
! string target

    rep_string = replace(string, char(target), substring, every, back)

! Finish

    return

  end function replace_CH_VS_CH_target

!****

  elemental function replace_VS_CH_CH_target (string, target, substring, every,
back) result (rep_string)

    type(varying_string), intent(in) :: string
    character(LEN=*), intent(in)     :: target
    character(LEN=*), intent(in)     :: substring
    logical, intent(in), optional    :: every
    logical, intent(in), optional    :: back
    type(varying_string)             :: rep_string

! Replace part of a varying string with a character
! substring, at a location matching a character-
! string target

    rep_string = replace(char(string), target, substring, every, back)

! Finish

    return

  end function replace_VS_CH_CH_target

!****

  elemental function replace_CH_CH_CH_target (string, target, substring, every,
back) result (rep_string)

    character(LEN=*), intent(in)  :: string
    character(LEN=*), intent(in)  :: target
    character(LEN=*), intent(in)  :: substring
    logical, intent(in), optional :: every
    logical, intent(in), optional :: back
    type(varying_string)          :: rep_string

    logical                       :: every_
    logical                       :: back_
    type(varying_string)          :: work_string
    integer                       :: length_target
    integer                       :: i_target

! Handle special cases when LEN(target) == 0. Such
! instances are prohibited by the standard, but
! since this function is elemental, no error can be
! thrown. Therefore, it makes sense to handle them 
! in a sensible manner

    if(LEN(target) == 0) then
       if(LEN(string) /= 0) then
          rep_string = string
       else
          rep_string = substring
       endif
       return
    end if

! Replace part of a character string with a character
! substring, at a location matching a character-
! string target

    if(PRESENT(every)) then
       every_ = every
    else
       every_ = .false.
    endif

    if(PRESENT(back)) then
       back_ = back
    else
       back_ = .false.
    endif

    rep_string = ''

    work_string = string

    length_target = LEN(target)

    replace_loop : do

       i_target = index(work_string, target, back_)

       if(i_target == 0) exit replace_loop

       if(back_) then
          rep_string = substring//extract(work_string,
start=i_target+length_target)//rep_string
          work_string = extract(work_string, finish=i_target-1)
       else
          rep_string = rep_string//extract(work_string,
finish=i_target-1)//substring
          work_string = extract(work_string, start=i_target+length_target)
       endif

       if(.NOT. every_) exit replace_loop

    end do replace_loop

    if(back_) then
       rep_string = work_string//rep_string
    else
       rep_string = rep_string//work_string
    endif

! Finish

    return

  end function replace_CH_CH_CH_target

!****

  elemental subroutine split_VS (string, word, set, separator, back)

    type(varying_string), intent(inout)         :: string
    type(varying_string), intent(out)           :: word
    type(varying_string), intent(in)            :: set
    type(varying_string), intent(out), optional :: separator
    logical, intent(in), optional               :: back

! Split a varying string into two verying strings

    call split_CH(string, word, char(set), separator, back)

! Finish

    return

  end subroutine split_VS

!****

  elemental subroutine split_CH (string, word, set, separator, back)

    type(varying_string), intent(inout)         :: string
    type(varying_string), intent(out)           :: word
    character(LEN=*), intent(in)                :: set
    type(varying_string), intent(out), optional :: separator
    logical, intent(in), optional               :: back

    logical                                     :: back_
    integer                                     :: i_separator

! Split a varying string into two verying strings

    if(PRESENT(back)) then
       back_ = back
    else
       back_ = .false.
    endif

    i_separator = scan(string, set, back_)

    if(i_separator /= 0) then

       if(back_) then
          word = extract(string, start=i_separator+1)
          if(PRESENT(separator)) separator = extract(string, start=i_separator,
finish=i_separator)
          string = extract(string, finish=i_separator-1)
       else
          word = extract(string, finish=i_separator-1)
          if(PRESENT(separator)) separator = extract(string, start=i_separator,
finish=i_separator)
          string = extract(string, start=i_separator+1)
       endif

    else

       word = string
       if(PRESENT(separator)) separator = ''
       string = ''

    endif

! Finish

    return

  end subroutine split_CH

end module iso_varying_string


!####################################################################################################################################


program test_iso
! uses iso_varying_string from
http://zuserver2.star.ucl.ac.uk/~rhdt/download/fortran/iso_varying_string.f90

use iso_varying_string

implicit none

character(len=80)    :: str=""
character(len=260)   :: textfile=""
type(varying_string) :: v_str
integer              :: i, ios
character(len=1)     :: newlinechar=";"


! read in a text file of your own choosing
write (*, '(/"Enter the name of any text file: ")', advance='NO')
read (*,'(A260)') textfile

! text.dat is an ASCII text file
open (unit=1,file=textfile, status='OLD', iostat=ios)

write (*,'("iostat on opening file= ",I0)') ios

if (ios.ne.0) stop 'Could not open file'



i = 0

! 1. read as a character string
write(*, '(/"read as a character string..."/)')

do
    read(1,'(A80)', iostat=ios) str
    if (ios.GT.0) stop 'Error on formatted read'
    if (ios.EQ.-1) exit
    i = i + 1
    print *, i, trim(str)
enddo

rewind(unit=1, iostat=ios)


write (*,'(/"iostat on rewind= ",I0)') ios

i = 0

! 2. read as an iso_varying_string without set
write(*, '(/"read as an iso_varying_string without optional SET..."/)')

do
    CALL get(unit=1,string=v_str, iostat=ios)
    if (ios.GT.0) stop 'Error on vs1 read'
    if (ios.EQ.-1) exit
    i = i + 1
    print *, i, trim(char(v_str))
enddo


rewind(unit=1, iostat=ios)


write (*,'(/"iostat on rewind= ",I0)') ios

i = 0

! 3. read as an iso_varying_string WITH 'set'...
write(*, '(/"read as an iso_varying_string with optional SET..."/)')

do
    CALL get(unit=1,string=v_str, set=newlinechar, iostat=ios)
    if (ios.GT.0) stop 'Error on vs2 read'
    if (ios.EQ.-1) exit
    i = i + 1
    print *, i, trim(char(v_str))
enddo


stop "Done."
end


-- 
           Summary: run time error (crash) - optional arguments, generics,
                    interface problem, iso_varying_string ??
           Product: gcc
           Version: 4.4.0
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: fortran
        AssignedTo: unassigned at gcc dot gnu dot org
        ReportedBy: davidgkinniburgh at yahoo dot co dot uk
 GCC build triplet: gcc version 4.4.0 20081219 (experimental) [trunk
                    revision 142842
  GCC host triplet: Win64 Vista Home
GCC target triplet: i586-pc-mingw32


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=38602

[Bug fortran/38602] run time error (crash) - optional arguments, generics, interface problem, iso_varying_string ??

[mikael at gcc dot gnu dot org]

------- Comment #1 from mikael at gcc dot gnu dot org  2008-12-21 23:38 -------
data file missing (Please attach this time if it's big)


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=38602

[Bug fortran/38602] [regression 4.4] segfault - optional arguments, generics, interface problem, iso_varying_string ??

[kargl at gcc dot gnu dot org]

------- Comment #2 from kargl at gcc dot gnu dot org  2008-12-22 00:28 -------
Please attach long files instead of embedded the code within the bug report.
It makes it harder to copy and paste from a browser.

The code works with 4.3.3, so this is a regression.  Here's a reduced 
testcase that needs to be linked to iso_varying_string.  Save this 
as lkl.f90 and compile.

program test_iso

   use iso_varying_string

   implicit none

   type(varying_string) :: v_str
   integer              :: i, ios
   character(len=1)     :: newlinechar=";"

   open (unit=1,file='lkl.f90', status='OLD')

   i = 0

   do
      CALL get(unit=1,string=v_str, set=newlinechar, iostat=ios)
      if (ios.GT.0) stop 'Error on vs2 read'
      if (ios.EQ.-1) exit
      i = i + 1
      print *, i, trim(char(v_str))
   end do
end


-- 

kargl at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|UNCONFIRMED                 |NEW
     Ever Confirmed|0                           |1
           Priority|P3                          |P4
   Last reconfirmed|0000-00-00 00:00:00         |2008-12-22 00:28:42
               date|                            |
            Summary|run time error (crash) -    |[regression 4.4] segfault -
                   |optional arguments,         |optional arguments,
                   |generics, interface problem,|generics, interface problem,
                   |iso_varying_string ??       |iso_varying_string ??


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=38602

[Bug fortran/38602] [regression 4.4] segfault - optional arguments, generics, interface problem, iso_varying_string ??

[kargl at gcc dot gnu dot org]

------- Comment #3 from kargl at gcc dot gnu dot org  2008-12-22 00:30 -------
Created an attachment (id=16956)
 --> (http://gcc.gnu.org/bugzilla/attachment.cgi?id=16956&action=view)
iso_varying_string code.

Here's the iso_varying_string.f90 code as an attachment.


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=38602

[Bug fortran/38602] [regression 4.4] segfault - optional arguments, generics, interface problem, iso_varying_string ??

[jvdelisle at gcc dot gnu dot org]

------- Comment #4 from jvdelisle at gcc dot gnu dot org  2008-12-22 05:18 -------
The test case passes at r142147 and fails at r142148

The patch to pr34820 caused this regression

        PR fortran/34820
        * trans-expr.c (gfc_conv_function_call): Remove all code to
        deallocate intent out derived types with allocatable
        components.
        (gfc_trans_assignment_1): An assignment from a scalar to an
        array of derived types with allocatable components, requires
        a deep copy to each array element and deallocation of the
        converted rhs expression afterwards.
        * trans-array.c : Minor whitespace.
        * trans-decl.c (init_intent_out_dt): Add code to deallocate
        allocatable components of derived types with intent out.
        (generate_local_decl): If these types are unused, set them
        referenced anyway but allow the uninitialized warning.


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=38602

[Bug fortran/38602] [regression 4.4] segfault - optional arguments, generics, interface problem, iso_varying_string ??

[mikael at gcc dot gnu dot org]

------- Comment #5 from mikael at gcc dot gnu dot org  2008-12-22 18:51 -------
Reduced:
program test_iso
   implicit none

   type varying_string
     character(LEN=1), dimension(:), allocatable :: chars
   end type varying_string

   CALL get_unit_set_ch ()

   contains

          subroutine get_unit_set_CH (separator)
            type(varying_string), intent(out), optional :: separator
          end subroutine get_unit_set_CH

end


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=38602

[Bug fortran/38602] [regression 4.4] segfault - optional arguments, generics, interface problem, iso_varying_string ??

[mikael at gcc dot gnu dot org]

------- Comment #6 from mikael at gcc dot gnu dot org  2008-12-22 18:54 -------
(In reply to comment #5)
Generated code:

get_unit_set_ch (struct varying_string * separator)
{
  if (separator->chars.data != 0B)
    {
      __builtin_free (separator->chars.data);
    }
  separator->chars.data = 0B;
}


test_iso ()
{
  static integer(kind=4) options.0[8] = {68, 255, 0, 0, 0, 1, 0, 1};
  static void get_unit_set_ch (struct varying_string *);

  _gfortran_set_options (8, (void *) &options.0);
  get_unit_set_ch (0B);
}


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=38602

[Bug fortran/38602] [regression 4.4] segfault - optional arguments, generics, interface problem, iso_varying_string ??

[mikael at gcc dot gnu dot org]

------- Comment #7 from mikael at gcc dot gnu dot org  2008-12-22 18:59 -------
This was probably a bad idea:
-          tmp = gfc_deallocate_alloc_comp (e->ts.derived, tmp, parm_rank);
-         if (e->expr_type == EXPR_VARIABLE &&
e->symtree->n.sym->attr.optional)
-           tmp = build3_v (COND_EXPR, gfc_conv_expr_present
(e->symtree->n.sym),
-                           tmp, build_empty_stmt ());


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=38602

[Bug fortran/38602] [regression 4.4] segfault - optional arguments, generics, interface problem, iso_varying_string ??

[pault at gcc dot gnu dot org]

------- Comment #8 from pault at gcc dot gnu dot org  2008-12-22 19:39 -------
Created an attachment (id=16969)
 --> (http://gcc.gnu.org/bugzilla/attachment.cgi?id=16969&action=view)
patch for the PR

This is a patch that I cannot commit until January 3rd at the earliest.  Please
could you do the honours, Jerry?  It runs all of alloc_comp*.f90 correctly but
I have NOT regtested it.

Paul

2008-12-22  Paul Thomas  <pault@gcc.gnu.org>

        PR fortran/35780
        * trans-decl.c (init_intent_out_dt): Allow for optional args.

2008-12-22  Paul Thomas  <pault@gcc.gnu.org>

        PR fortran/35780
        * gfortran.dg/alloc_comp_optional_1.f90: New test.

! { dg-do run }
! Tests the fix for PR38602, a regression caused by a modification
! to the nulling of INTENT_OUT dummies with allocatable components
! that caused a segfault with optional arguments.
!
! Contributed by David Kinniburgh <davidkinniburgh@yahoo.co.uk>
!
program test_iso
  type ivs
     character(LEN=1), dimension(:), allocatable :: chars
  end type ivs
  type(ivs) :: v_str
  integer :: i
  call foo(v_str, i)
  if (v_str%chars(1) .ne. "a") call abort
  if (i .ne. 0) call abort
  call foo(flag = i)
  if (i .ne. 1) call abort
contains
  subroutine foo (arg, flag)
    type(ivs), optional, intent(out) :: arg
    integer :: flag
    if (present(arg)) then
      arg = ivs([(char(i+96), i = 1,10)])
      flag = 0
    else
      flag = 1
    end if
  end subroutine
end


-- 

pault at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
         AssignedTo|unassigned at gcc dot gnu   |pault at gcc dot gnu dot org
                   |dot org                     |
             Status|NEW                         |ASSIGNED


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=38602

[Bug fortran/38602] [regression 4.4] segfault - optional arguments, generics, interface problem, iso_varying_string ??

[pault at gcc dot gnu dot org]

------- Comment #9 from pault at gcc dot gnu dot org  2008-12-22 20:03 -------
Created an attachment (id=16970)
 --> (http://gcc.gnu.org/bugzilla/attachment.cgi?id=16970&action=view)
The real patch for the PR without the extra bits:-)

Have eliminated the extra bits on the patch - sorry about that!

Paul


-- 

pault at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
  Attachment #16969|0                           |1
        is obsolete|                            |


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=38602

[Bug fortran/38602] [regression 4.4] segfault - optional arguments, generics, interface problem, iso_varying_string ??

[jvdelisle at gcc dot gnu dot org]

------- Comment #10 from jvdelisle at gcc dot gnu dot org  2008-12-22 20:53 -------
Regression testing now and will commit when complete.


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=38602

[Bug fortran/38602] [regression 4.4] segfault - optional arguments, generics, interface problem, iso_varying_string ??

[jvdelisle at gcc dot gnu dot org]

------- Comment #11 from jvdelisle at gcc dot gnu dot org  2008-12-22 23:39 -------
Patch committed, fixed on trunk, 4.4


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=38602

[Bug fortran/38602] [regression 4.4] segfault - optional arguments, generics, interface problem, iso_varying_string ??

[mikael at gcc dot gnu dot org]

------- Comment #12 from mikael at gcc dot gnu dot org  2008-12-23 00:18 -------
(In reply to comment #11)
> Patch committed, fixed on trunk, 4.4
I think it was the wrong PR number (35780 instead of PR34820).


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=38602

[Bug fortran/38602] [regression 4.4] segfault - optional arguments, generics, interface problem, iso_varying_string ??

[jvdelisle at verizon dot net]

------- Comment #13 from jvdelisle at verizon dot net  2008-12-23 01:11 -------
Subject: Re:  [regression 4.4] segfault - optional
 arguments, generics, interface problem, iso_varying_string ??

mikael at gcc dot gnu dot org wrote:
> ------- Comment #12 from mikael at gcc dot gnu dot org  2008-12-23 00:18 -------
> (In reply to comment #11)
>> Patch committed, fixed on trunk, 4.4
> I think it was the wrong PR number (35780 instead of PR34820).
> 
> 
Yes, I will fix the log.


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=38602

[Bug fortran/38602] [regression 4.4] segfault - optional arguments, generics, interface problem, iso_varying_string ??

[jvdelisle at gcc dot gnu dot org]

------- Comment #14 from jvdelisle at gcc dot gnu dot org  2008-12-23 01:33 -------
Subject: Bug 38602

Author: jvdelisle
Date: Tue Dec 23 01:32:33 2008
New Revision: 142898

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=142898
Log:
2008-12-22  Paul Thomas  <pault@gcc.gnu.org>

        PR fortran/38602
        * trans-decl.c (init_intent_out_dt): Allow for optional args.

Modified:
    branches/gcc-4_3-branch/gcc/fortran/ChangeLog
    branches/gcc-4_3-branch/gcc/fortran/trans-decl.c


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=38602

[Bug fortran/38602] [regression 4.4] segfault - optional arguments, generics, interface problem, iso_varying_string ??

[jvdelisle at gcc dot gnu dot org]

------- Comment #15 from jvdelisle at gcc dot gnu dot org  2008-12-23 01:35 -------
Subject: Bug 38602

Author: jvdelisle
Date: Tue Dec 23 01:34:13 2008
New Revision: 142899

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=142899
Log:
2008-12-22  Paul Thomas  <pault@gcc.gnu.org>

        PR fortran/38602
        * gfortran.dg/alloc_comp_optional_1.f90: New test.

Added:
    branches/gcc-4_3-branch/gcc/testsuite/gfortran.dg/alloc_comp_optional_1.f90
Modified:
    branches/gcc-4_3-branch/gcc/testsuite/ChangeLog


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=38602

[Bug fortran/38602] [regression 4.4] segfault - optional arguments, generics, interface problem, iso_varying_string ??

[jvdelisle at gcc dot gnu dot org]

------- Comment #16 from jvdelisle at gcc dot gnu dot org  2008-12-23 02:10 -------
Fixed on 4.3, closing.  Thanks everyone for the help with this.


-- 

jvdelisle at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|ASSIGNED                    |RESOLVED
         Resolution|                            |FIXED
   Target Milestone|---                         |4.3.4


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=38602

[Bug fortran/38602] [regression 4.4] segfault - optional arguments, generics, interface problem, iso_varying_string ??

[pault at gcc dot gnu dot org]

------- Comment #17 from pault at gcc dot gnu dot org  2008-12-23 09:26 -------
(In reply to comment #12)
> (In reply to comment #11)
> > Patch committed, fixed on trunk, 4.4
> I think it was the wrong PR number (35780 instead of PR34820).
> 
Dang it! Sorry about that, I used the ChangeLogs from 35780 as a template and
forgot to update the numbers.

Thanks for helping out.

Paul


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=38602

[Bug fortran/38602] [regression 4.4] segfault - optional arguments, generics, interface problem, iso_varying_string ??

[rguenth at gcc dot gnu dot org]

-- 

rguenth at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
   Target Milestone|4.3.4                       |4.3.3


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=38602