git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/33077 (RANDOM_SEED failure for integer(kind=8)) 

PR fortran/33077
	* intrinsics/random.c (random_seed_i8): Fix code logic.
	* gfortran.dg/random_7.f90: Initialize variable.

From-SVN: r127512
This commit is contained in:
Francois-Xavier Coudert 2007-08-15 12:35:57 +00:00 committed by François-Xavier Coudert
parent 49317655fe
commit ee5d176a88
4 changed files with 17 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2007-08-15 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/33077
* gfortran.dg/random_7.f90: Initialize variable.
2007-08-15 Jakub Jelinek <jakub@redhat.com> 2007-08-15 Jakub Jelinek <jakub@redhat.com>
PR middle-end/33074 PR middle-end/33074

3
gcc/testsuite/gfortran.dg/random_7.f90
View File

@ -7,8 +7,11 @@ program trs
integer, allocatable, dimension(:) :: seed, check integer, allocatable, dimension(:) :: seed, check
call test_random_seed(size) call test_random_seed(size)
allocate(seed(size),check(size)) allocate(seed(size),check(size))
seed(:) = huge(seed) / 17
call test_random_seed(put=seed) call test_random_seed(put=seed)
call test_random_seed(get=check) call test_random_seed(get=check)
print *, seed
print *, check
if (any (seed /= check)) call abort if (any (seed /= check)) call abort
contains contains
subroutine test_random_seed(size, put, get) subroutine test_random_seed(size, put, get)

5
libgfortran/ChangeLog
View File

@ -1,3 +1,8 @@
2007-08-15 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/33077
* intrinsics/random.c (random_seed_i8): Fix code logic.
2007-08-13 Danny Smith <dannysmit@users.sourceforge.net> 2007-08-13 Danny Smith <dannysmit@users.sourceforge.net>
* acinclude.m4 (GTHREAD_USE_WEAK) Define to 0 for mingw32. * acinclude.m4 (GTHREAD_USE_WEAK) Define to 0 for mingw32.

8
libgfortran/intrinsics/random.c
View File

@ -731,8 +731,8 @@ random_seed_i8 (GFC_INTEGER_8 *size, gfc_array_i8 *put, gfc_array_i8 *get)
runtime_error ("Array size of PUT is too small."); runtime_error ("Array size of PUT is too small.");
/* This code now should do correct strides. */ /* This code now should do correct strides. */
for (i = 0; i < kiss_size; i += 2) for (i = 0; i < kiss_size / 2; i++)
memcpy (&kiss_seed[i], &(put->data[i * put->dim[0].stride]), memcpy (&kiss_seed[2*i], &(put->data[i * put->dim[0].stride]),
sizeof (GFC_UINTEGER_8)); sizeof (GFC_UINTEGER_8));
} }
@ -748,8 +748,8 @@ random_seed_i8 (GFC_INTEGER_8 *size, gfc_array_i8 *put, gfc_array_i8 *get)
runtime_error ("Array size of GET is too small."); runtime_error ("Array size of GET is too small.");
/* This code now should do correct strides. */ /* This code now should do correct strides. */
for (i = 0; i < kiss_size; i += 2) for (i = 0; i < kiss_size / 2; i++)
memcpy (&(get->data[i * get->dim[0].stride]), &kiss_seed[i], memcpy (&(get->data[i * get->dim[0].stride]), &kiss_seed[2*i],
sizeof (GFC_UINTEGER_8)); sizeof (GFC_UINTEGER_8));
} }