diff options
| author | Harald Anlauf <anlauf@gmx.de> | 2025-03-17 22:34:19 +0100 |
|---|---|---|
| committer | Harald Anlauf <anlauf@gmx.de> | 2025-03-18 18:56:08 +0100 |
| commit | 6cbeab134f048d65ed615ed587f6ae0b01d1c336 (patch) | |
| tree | 2aada661fda100691cea76bce9e6a4b7ce636501 /gcc/fortran | |
| parent | a03e9d4932713c1696bb2bc134da8e8eac3edb94 (diff) | |
| download | gcc-6cbeab134f048d65ed615ed587f6ae0b01d1c336.zip gcc-6cbeab134f048d65ed615ed587f6ae0b01d1c336.tar.gz gcc-6cbeab134f048d65ed615ed587f6ae0b01d1c336.tar.bz2 | |
Fortran: check type-spec in ALLOCATE of dummy with assumed length [PR119338]
PR fortran/119338
gcc/fortran/ChangeLog:
* resolve.cc (resolve_allocate_expr): Check F2003:C626: Type-spec
in ALLOCATE of an assumed-length character dummy argument shall be
an asterisk.
gcc/testsuite/ChangeLog:
* gfortran.dg/deferred_character_18.f90: Adjust testcase.
* gfortran.dg/allocate_assumed_charlen_5.f90: New test.
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/resolve.cc | 16 |
1 files changed, 16 insertions, 0 deletions
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index d64edff..ddd9827 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -8987,6 +8987,22 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec) goto failure; } + /* F2003:C626 (R623) A type-param-value in a type-spec shall be an asterisk + if and only if each allocate-object is a dummy argument for which the + corresponding type parameter is assumed. */ + if (code->ext.alloc.ts.type == BT_CHARACTER + && code->ext.alloc.ts.u.cl->length != NULL + && e->ts.type == BT_CHARACTER && !e->ts.deferred + && e->ts.u.cl->length == NULL + && e->symtree->n.sym->attr.dummy) + { + gfc_error ("The type parameter in ALLOCATE statement with type-spec " + "shall be an asterisk as allocate object %qs at %L is a " + "dummy argument with assumed type parameter", + sym->name, &e->where); + goto failure; + } + /* Check F08:C632. */ if (code->ext.alloc.ts.type == BT_CHARACTER && !e->ts.deferred && !UNLIMITED_POLY (e)) |