diff options
Diffstat (limited to 'libgfortran')
| -rw-r--r-- | libgfortran/ChangeLog | 13 | ||||
| -rw-r--r-- | libgfortran/gfortran.map | 6 | ||||
| -rw-r--r-- | libgfortran/intrinsics/extends_type_of.c | 2 | ||||
| -rw-r--r-- | libgfortran/intrinsics/string_intrinsics_inc.c | 52 | ||||
| -rw-r--r-- | libgfortran/io/list_read.c | 28 |
5 files changed, 100 insertions, 1 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 057b850..440a32a 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,16 @@ +2025-08-06 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR libfortran/121234 + * io/list_read.c (read_character): Add checks to bypass eating + semicolons when reading strings with decimal mode 'point' + (list_formatted_read_scalar): Likewise. + +2025-07-30 Yuao Ma <c8ef@outlook.com> + + * gfortran.map: Add split symbol. + * intrinsics/string_intrinsics_inc.c (string_split): + Runtime support for SPLIT. + 2025-06-18 Harald Anlauf <anlauf@gmx.de> PR fortran/82480 diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map index 742dddf..98808dc 100644 --- a/libgfortran/gfortran.map +++ b/libgfortran/gfortran.map @@ -2032,3 +2032,9 @@ GFORTRAN_15.2 { _gfortran_mmaxloc1_16_m16; _gfortran_smaxloc1_16_m16; } GFORTRAN_15; + +GFORTRAN_16 { + global: + _gfortran_string_split; + _gfortran_string_split_char4; +} GFORTRAN_15.2; diff --git a/libgfortran/intrinsics/extends_type_of.c b/libgfortran/intrinsics/extends_type_of.c index 8768b2d..dab14ee 100644 --- a/libgfortran/intrinsics/extends_type_of.c +++ b/libgfortran/intrinsics/extends_type_of.c @@ -58,7 +58,7 @@ is_extension_of (struct vtype *v1, struct vtype *v2) while (v1) { - if (v1->hash == v2->hash) return 1; + if (v1 == v2) return 1; v1 = v1->extends; } return 0; diff --git a/libgfortran/intrinsics/string_intrinsics_inc.c b/libgfortran/intrinsics/string_intrinsics_inc.c index d86bb6c8..aeecf68 100644 --- a/libgfortran/intrinsics/string_intrinsics_inc.c +++ b/libgfortran/intrinsics/string_intrinsics_inc.c @@ -33,6 +33,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #define string_verify SUFFIX(string_verify) #define string_trim SUFFIX(string_trim) #define string_minmax SUFFIX(string_minmax) +#define string_split SUFFIX(string_split) #define zero_length_string SUFFIX(zero_length_string) #define compare_string SUFFIX(compare_string) @@ -72,6 +73,10 @@ export_proto(string_trim); extern void string_minmax (gfc_charlen_type *, CHARTYPE **, int, int, ...); export_proto(string_minmax); +extern gfc_charlen_type string_split (gfc_charlen_type, const CHARTYPE *, + gfc_charlen_type, const CHARTYPE *, + gfc_charlen_type, GFC_LOGICAL_4); +export_proto (string_split); /* Use for functions which can return a zero-length string. */ static CHARTYPE zero_length_string = 0; @@ -459,3 +464,50 @@ string_minmax (gfc_charlen_type *rlen, CHARTYPE **dest, int op, int nargs, ...) *dest = tmp; } } + +gfc_charlen_type +string_split (gfc_charlen_type stringlen, const CHARTYPE *string, + gfc_charlen_type setlen, const CHARTYPE *set, + gfc_charlen_type pos, GFC_LOGICAL_4 back) +{ + gfc_charlen_type i, j; + + if (!back) + { + if (pos > stringlen) + runtime_error ("If BACK is present with the value false, the value of " + "POS shall be in the range [0, LEN (STRING)], " + "where POS = %ld and LEN (STRING) = %ld", + pos, stringlen); + + for (i = pos + 1; i <= stringlen; i++) + { + for (j = 0; j < setlen; j++) + { + if (string[i - 1] == set[j]) + return i; + } + } + + return stringlen + 1; + } + else + { + if (pos < 1 || pos > (stringlen + 1)) + runtime_error ("If BACK is present with the value true, the value of " + "POS shall be in the range [1, LEN (STRING) + 1], " + "where POS = %ld and LEN (STRING) = %ld", + pos, stringlen); + + for (i = pos - 1; i != 0; i--) + { + for (j = 0; j < setlen; j++) + { + if (string[i - 1] == set[j]) + return i; + } + } + + return 0; + } +} diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 83124b5..7c22f61 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -1262,6 +1262,11 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused))) if ((c = next_char (dtp)) == EOF) goto eof; + if (c == ';') + { + push_char (dtp, c); + goto get_string; + } switch (c) { CASE_DIGITS: @@ -1294,6 +1299,13 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused))) for (;;) { c = next_char (dtp); + + if (c == ';') + { + push_char (dtp, c); + goto get_string; + } + switch (c) { CASE_DIGITS: @@ -1323,6 +1335,13 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused))) if ((c = next_char (dtp)) == EOF) goto eof; + + if (c == ';') + { + push_char (dtp, c); + goto get_string; + } + switch (c) { CASE_SEPARATORS: @@ -1346,6 +1365,13 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused))) { if ((c = next_char (dtp)) == EOF) goto done_eof; + + if (c == ';') + { + push_char (dtp, c); + continue; + } + switch (c) { case '"': @@ -2275,6 +2301,8 @@ list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p, } if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) c = '.'; + if (c == ';' && dtp->u.p.current_unit->decimal_status == DECIMAL_POINT) + unget_char (dtp, c); else if (is_separator (c)) { /* Found a null value. */ |