procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR libfortran/56737 (Wrong I/O result with format cache for Hollerith strings)

Browse source 
2013-03-29  Tobias Burnus  <burnus@net-b.de>

        PR fortran/56737
        * io/format.c (parse_format): With caching, copy
        dtp->format string.
        (save_parsed_format): Use dtp->format directy without
        copying.

2013-03-29  Tobias Burnus  <burnus@net-b.de>

        PR fortran/56737
        * testsuite/gfortran.dg/fmt_cache_3.f90: New.

(Plus: Move fortran/ChangeLog item to libgfortran/ChangeLog)

From-SVN: r197229
This commit is contained in:
Tobias Burnus 2013-03-29 10:37:37 +01:00 • committed by Tobias Burnus
parent a0b012be6a
commit d80b9b4777
5 changed files with 110 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View file

@ -1,10 +1,3 @@
2013-03-29 Tobias Burnus <burnus@net-b.de>
PR fortran/56735
* io/list_read.c (nml_query): Only abort when
an error occured.
(namelist_read): Add goto instead of falling through.
2013-03-28 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/45159

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2013-03-29 Tobias Burnus <burnus@net-b.de>
PR fortran/56737
* testsuite/gfortran.dg/fmt_cache_3.f90: New.
2013-03-29 Tobias Burnus <burnus@net-b.de>
PR fortran/56735

80
gcc/testsuite/gfortran.dg/fmt_cache_3.f90 Normal file
View file

@ -0,0 +1,80 @@
! { dg-do run }
!
! PR fortran/56737
!
! Contributed by Jonathan Hogg
!
module hsl_mc73_single
implicit none
integer, parameter, private :: wp = kind(0.0)
contains
subroutine mc73_fiedler(n,lirn,irn,ip,list)
integer, intent (in) :: n
integer, intent (in) :: lirn
integer, intent (in) :: irn(*)
integer, intent (in) :: ip(*)
integer, intent (out) :: list(*)
integer :: icntl(10)
call fiedler_graph(icntl)
end subroutine mc73_fiedler
subroutine mc73_order
integer :: icntl(10)
call fiedler_graph(icntl)
end subroutine mc73_order
subroutine fiedler_graph(icntl)
integer, intent (in) :: icntl(10)
real (kind = wp) :: tol
real (kind = wp) :: tol1
real (kind = wp) :: rtol
call multilevel_eig(tol,tol1,rtol,icntl)
end subroutine fiedler_graph
subroutine multilevel_eig(tol,tol1,rtol,icntl)
real (kind = wp), intent (in) :: tol,tol1,rtol
integer, intent(in) :: icntl(10)
call level_print(6,'end of level ',1)
end subroutine multilevel_eig
subroutine level_print(mp,title1,level)
character (len = *), intent(in) :: title1
integer, intent(in) :: mp,level
character(len=80) fmt
integer :: char_len1,char_len2
char_len1=len_trim(title1)
write (fmt,"('(',i4,'(1H ),6h===== ,a',i4,',i4,6h =====)')") &
level*3, char_len1
! print *, "fmt = ", fmt
! print *, "title1= ", title1
! print *, "level = ", level
write (66,fmt) title1,level
end subroutine level_print
end module hsl_mc73_single
program test
use hsl_mc73_single
implicit none
character(len=200) :: str(2)
integer, parameter :: wp = kind(0.0)
integer :: n, lirn
integer :: irn(1), ip(1), list(1)
str = ""
open (66, status='scratch')
call mc73_order
call mc73_fiedler(n,lirn,irn,ip,list)
rewind (66)
read (66, '(a)') str
close (66)
if (any (str /= " ===== end of level 1 =====")) call abort()
end program test

15
libgfortran/ChangeLog
View file

@ -1,3 +1,18 @@
2013-03-29 Tobias Burnus <burnus@net-b.de>
PR fortran/56737
* io/format.c (parse_format): With caching, copy
dtp->format string.
(save_parsed_format): Use dtp->format directy without
copying.
2013-03-29 Tobias Burnus <burnus@net-b.de>
PR fortran/56735
* io/list_read.c (nml_query): Only abort when
an error occured.
(namelist_read): Add goto instead of falling through.
2013-03-25 Tilo Schwarz <tilo@tilo-schwarz.de>
PR libfortran/52512

12
libgfortran/io/format.c
View file

@ -148,8 +148,7 @@ save_parsed_format (st_parameter_dt *dtp)
u->format_hash_table[hash].hashed_fmt = NULL;
free (u->format_hash_table[hash].key);
u->format_hash_table[hash].key = xmalloc (dtp->format_len);
memcpy (u->format_hash_table[hash].key, dtp->format, dtp->format_len);
u->format_hash_table[hash].key = dtp->format;
u->format_hash_table[hash].key_len = dtp->format_len;
u->format_hash_table[hash].hashed_fmt = dtp->u.p.fmt;
@ -1223,6 +1222,13 @@ parse_format (st_parameter_dt *dtp)
/* Not found so proceed as follows. */
if (format_cache_ok)
{
char *fmt_string = xmalloc (dtp->format_len);
memcpy (fmt_string, dtp->format, dtp->format_len);
dtp->format = fmt_string;
}
dtp->u.p.fmt = fmt = xmalloc (sizeof (format_data));
fmt->format_string = dtp->format;
fmt->format_string_len = dtp->format_len;
@ -1257,6 +1263,8 @@ parse_format (st_parameter_dt *dtp)
if (fmt->error)
{
format_error (dtp, NULL, fmt->error);
if (format_cache_ok)
free (dtp->format);
free_format_hash_table (dtp->u.p.current_unit);
return;
}