diff options
| author | Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> | 2007-08-17 13:09:23 +0000 |
|---|---|---|
| committer | François-Xavier Coudert <fxcoudert@gcc.gnu.org> | 2007-08-17 13:09:23 +0000 |
| commit | 000007c53553607813c99368b67c2691bf11eab9 (patch) | |
| tree | 13fdeb4ff7ed9cef89a72af1fccc8442c308d49d | |
| parent | 5d39d00bb989107b4bf19311d19eaffc9bc6bf03 (diff) | |
| download | gcc-000007c53553607813c99368b67c2691bf11eab9.zip gcc-000007c53553607813c99368b67c2691bf11eab9.tar.gz gcc-000007c53553607813c99368b67c2691bf11eab9.tar.bz2 | |
re PR libfortran/33079 (Optional empty strings do not appear to be 'PRESENT')
PR fortran/33079
* intrinsics/string_intrinsics.c (string_trim, string_minmax): Fix
the zero-length result case.
* gfortran.dg/zero_length_2.f90: New test.
From-SVN: r127584
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/zero_length_2.f90 | 16 | ||||
| -rw-r--r-- | libgfortran/ChangeLog | 6 | ||||
| -rw-r--r-- | libgfortran/intrinsics/string_intrinsics.c | 20 |
4 files changed, 39 insertions, 8 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a320c2e..7ababfa 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2007-08-17 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + PR fortran/33079 + * gfortran.dg/zero_length_2.f90: New test. + 2007-08-17 Tobias Burnus <burnus@net-b.de> * gfortran.dg/kind_tests_2.f03: Add cleanup-modules. diff --git a/gcc/testsuite/gfortran.dg/zero_length_2.f90 b/gcc/testsuite/gfortran.dg/zero_length_2.f90 new file mode 100644 index 0000000..31b99f5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/zero_length_2.f90 @@ -0,0 +1,16 @@ +! { dg-do run } + character(len=1) :: s + character(len=0) :: s0 ! { dg-warning "CHARACTER variable has zero length" } + s = " " + s0 = "" + call bar ("") + call bar (s) + call bar (s0) + call bar (trim(s)) + call bar (min(s0,s0)) +contains + subroutine bar (s) + character(len=*), optional :: s + if (.not. present (S)) call abort + end subroutine bar +end diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 2305b3e..de3d574 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,9 @@ +2007-08-17 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + PR fortran/33079 + * intrinsics/string_intrinsics.c (string_trim, string_minmax): Fix + the zero-length result case. + 2007-08-15 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> PR fortran/33077 diff --git a/libgfortran/intrinsics/string_intrinsics.c b/libgfortran/intrinsics/string_intrinsics.c index be02811..c663daa 100644 --- a/libgfortran/intrinsics/string_intrinsics.c +++ b/libgfortran/intrinsics/string_intrinsics.c @@ -77,6 +77,11 @@ export_proto(string_trim); extern void string_minmax (GFC_INTEGER_4 *, void **, int, int, ...); export_proto(string_minmax); + +/* Use for functions which can return a zero-length string. */ +static char zero_length_string = '\0'; + + /* Strings of unequal length are extended with pad characters. */ int @@ -167,16 +172,16 @@ string_trim (GFC_INTEGER_4 * len, void ** dest, GFC_INTEGER_4 slen, } *len = i + 1; - if (*len > 0) + if (*len == 0) + *dest = &zero_length_string; + else { /* Allocate space for result string. */ *dest = internal_malloc_size (*len); - /* copy string if necessary. */ + /* Copy string if necessary. */ memmove (*dest, src, *len); } - else - *dest = NULL; } @@ -403,14 +408,13 @@ string_minmax (GFC_INTEGER_4 *rlen, void **dest, int op, int nargs, ...) } va_end (ap); - if (*rlen > 0) + if (*rlen == 0) + *dest = &zero_length_string; + else { char * tmp = internal_malloc_size (*rlen); memcpy (tmp, res, reslen); memset (&tmp[reslen], ' ', *rlen - reslen); *dest = tmp; } - else - *dest = NULL; } - |