diff options
Diffstat (limited to 'libgfortran')
| -rw-r--r-- | libgfortran/ChangeLog | 6 | ||||
| -rw-r--r-- | libgfortran/gfortran.map | 6 | ||||
| -rw-r--r-- | libgfortran/intrinsics/string_intrinsics_inc.c | 52 |
3 files changed, 64 insertions, 0 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 057b850..ea41616 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,9 @@ +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/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; + } +} |