Commit 000007c5 by Francois-Xavier Coudert Committed by François-Xavier Coudert

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
parent 5d39d00b
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> 2007-08-17 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/kind_tests_2.f03: Add cleanup-modules. * gfortran.dg/kind_tests_2.f03: Add cleanup-modules.
! { 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
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> 2007-08-15 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/33077 PR fortran/33077
......
...@@ -77,6 +77,11 @@ export_proto(string_trim); ...@@ -77,6 +77,11 @@ export_proto(string_trim);
extern void string_minmax (GFC_INTEGER_4 *, void **, int, int, ...); extern void string_minmax (GFC_INTEGER_4 *, void **, int, int, ...);
export_proto(string_minmax); 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. */ /* Strings of unequal length are extended with pad characters. */
int int
...@@ -167,16 +172,16 @@ string_trim (GFC_INTEGER_4 * len, void ** dest, GFC_INTEGER_4 slen, ...@@ -167,16 +172,16 @@ string_trim (GFC_INTEGER_4 * len, void ** dest, GFC_INTEGER_4 slen,
} }
*len = i + 1; *len = i + 1;
if (*len > 0) if (*len == 0)
*dest = &zero_length_string;
else
{ {
/* Allocate space for result string. */ /* Allocate space for result string. */
*dest = internal_malloc_size (*len); *dest = internal_malloc_size (*len);
/* copy string if necessary. */ /* Copy string if necessary. */
memmove (*dest, src, *len); memmove (*dest, src, *len);
} }
else
*dest = NULL;
} }
...@@ -403,14 +408,13 @@ string_minmax (GFC_INTEGER_4 *rlen, void **dest, int op, int nargs, ...) ...@@ -403,14 +408,13 @@ string_minmax (GFC_INTEGER_4 *rlen, void **dest, int op, int nargs, ...)
} }
va_end (ap); va_end (ap);
if (*rlen > 0) if (*rlen == 0)
*dest = &zero_length_string;
else
{ {
char * tmp = internal_malloc_size (*rlen); char * tmp = internal_malloc_size (*rlen);
memcpy (tmp, res, reslen); memcpy (tmp, res, reslen);
memset (&tmp[reslen], ' ', *rlen - reslen); memset (&tmp[reslen], ' ', *rlen - reslen);
*dest = tmp; *dest = tmp;
} }
else
*dest = NULL;
} }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment