https://gcc.gnu.org/g:18e49f19f5907de8d28cd33a8789946a3f5092ce
commit r16-3462-g18e49f19f5907de8d28cd33a8789946a3f5092ce
Author: Harald Anlauf <anl...@gmx.de>
Date: Thu Aug 28 22:07:10 2025 +0200
Fortran: improve compile-time checking of character dummy arguments
[PR93330]
PR fortran/93330
gcc/fortran/ChangeLog:
* interface.cc (get_sym_storage_size): Add argument size_known to
indicate that the storage size could be successfully determined.
(get_expr_storage_size): Likewise.
(gfc_compare_actual_formal): Use them to handle zero-sized dummy
and actual arguments.
If a character formal argument has the pointer or allocatable
attribute, or is an array that is not assumed or explicit size,
we generate an error by default unless -std=legacy is specified,
which falls back to just giving a warning.
If -Wcharacter-truncation is given, warn on a character actual
argument longer than the dummy. Generate an error for too short
scalar character arguments if -std=f* is given instead of just a
warning.
gcc/testsuite/ChangeLog:
* gfortran.dg/argument_checking_15.f90: Adjust dg-pattern.
* gfortran.dg/bounds_check_strlen_7.f90: Add dg-pattern.
* gfortran.dg/char_length_3.f90: Adjust options.
* gfortran.dg/whole_file_24.f90: Add dg-pattern.
* gfortran.dg/whole_file_29.f90: Likewise.
* gfortran.dg/argument_checking_27.f90: New test.
Diff:
---
gcc/fortran/interface.cc | 156 +++++++++++---
gcc/testsuite/gfortran.dg/argument_checking_15.f90 | 4 +-
gcc/testsuite/gfortran.dg/argument_checking_27.f90 | 240 +++++++++++++++++++++
.../gfortran.dg/bounds_check_strlen_7.f90 | 3 +-
gcc/testsuite/gfortran.dg/char_length_3.f90 | 1 +
gcc/testsuite/gfortran.dg/whole_file_24.f90 | 2 +-
gcc/testsuite/gfortran.dg/whole_file_29.f90 | 2 +-
7 files changed, 370 insertions(+), 38 deletions(-)
diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index d08f683498d1..ef5a17d0af45 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -3007,15 +3007,17 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
}
-/* Returns the storage size of a symbol (formal argument) or
- zero if it cannot be determined. */
+/* Returns the storage size of a symbol (formal argument) or sets argument
+ size_known to false if it cannot be determined. */
static unsigned long
-get_sym_storage_size (gfc_symbol *sym)
+get_sym_storage_size (gfc_symbol *sym, bool *size_known)
{
int i;
unsigned long strlen, elements;
+ *size_known = false;
+
if (sym->ts.type == BT_CHARACTER)
{
if (sym->ts.u.cl && sym->ts.u.cl->length
@@ -3029,7 +3031,10 @@ get_sym_storage_size (gfc_symbol *sym)
strlen = 1;
if (symbol_rank (sym) == 0)
- return strlen;
+ {
+ *size_known = true;
+ return strlen;
+ }
elements = 1;
if (sym->as->type != AS_EXPLICIT)
@@ -3046,17 +3051,19 @@ get_sym_storage_size (gfc_symbol *sym)
- mpz_get_si (sym->as->lower[i]->value.integer) + 1L;
}
+ *size_known = true;
+
return strlen*elements;
}
-/* Returns the storage size of an expression (actual argument) or
- zero if it cannot be determined. For an array element, it returns
- the remaining size as the element sequence consists of all storage
+/* Returns the storage size of an expression (actual argument) or sets argument
+ size_known to false if it cannot be determined. For an array element, it
+ returns the remaining size as the element sequence consists of all storage
units of the actual argument up to the end of the array. */
static unsigned long
-get_expr_storage_size (gfc_expr *e)
+get_expr_storage_size (gfc_expr *e, bool *size_known)
{
int i;
long int strlen, elements;
@@ -3064,6 +3071,8 @@ get_expr_storage_size (gfc_expr *e)
bool is_str_storage = false;
gfc_ref *ref;
+ *size_known = false;
+
if (e == NULL)
return 0;
@@ -3083,7 +3092,10 @@ get_expr_storage_size (gfc_expr *e)
strlen = 1; /* Length per element. */
if (e->rank == 0 && !e->ref)
- return strlen;
+ {
+ *size_known = true;
+ return strlen;
+ }
elements = 1;
if (!e->ref)
@@ -3092,7 +3104,10 @@ get_expr_storage_size (gfc_expr *e)
return 0;
for (i = 0; i < e->rank; i++)
elements *= mpz_get_si (e->shape[i]);
- return elements*strlen;
+ {
+ *size_known = true;
+ return elements*strlen;
+ }
}
for (ref = e->ref; ref; ref = ref->next)
@@ -3231,6 +3246,8 @@ get_expr_storage_size (gfc_expr *e)
}
}
+ *size_known = true;
+
if (substrlen)
return (is_str_storage) ? substrlen + (elements-1)*strlen
: elements*strlen;
@@ -3331,7 +3348,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap,
gfc_formal_arglist *formal,
gfc_array_spec *fas, *aas;
bool pointer_dummy, pointer_arg, allocatable_arg;
bool procptr_dummy, optional_dummy, allocatable_dummy;
-
+ bool actual_size_known = false;
+ bool formal_size_known = false;
bool ok = true;
actual = *ap;
@@ -3584,20 +3602,39 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap,
gfc_formal_arglist *formal,
&& (mpz_cmp (a->expr->ts.u.cl->length->value.integer,
f->sym->ts.u.cl->length->value.integer) != 0))
{
+ long actual_len, formal_len;
+ actual_len = mpz_get_si (a->expr->ts.u.cl->length->value.integer);
+ formal_len = mpz_get_si (f->sym->ts.u.cl->length->value.integer);
+
if (where && (f->sym->attr.pointer || f->sym->attr.allocatable))
- gfc_warning (0, "Character length mismatch (%ld/%ld) between actual
"
- "argument and pointer or allocatable dummy argument "
- "%qs at %L",
- mpz_get_si (a->expr->ts.u.cl->length->value.integer),
- mpz_get_si (f->sym->ts.u.cl->length->value.integer),
- f->sym->name, &a->expr->where);
+ {
+ /* Emit a warning for -std=legacy and an error otherwise. */
+ if (gfc_option.warn_std == 0)
+ gfc_warning (0, "Character length mismatch (%ld/%ld) between "
+ "actual argument and pointer or allocatable "
+ "dummy argument %qs at %L", actual_len, formal_len,
+ f->sym->name, &a->expr->where);
+ else
+ gfc_error ("Character length mismatch (%ld/%ld) between "
+ "actual argument and pointer or allocatable "
+ "dummy argument %qs at %L", actual_len, formal_len,
+ f->sym->name, &a->expr->where);
+ }
else if (where)
- gfc_warning (0, "Character length mismatch (%ld/%ld) between actual
"
- "argument and assumed-shape dummy argument %qs "
- "at %L",
- mpz_get_si (a->expr->ts.u.cl->length->value.integer),
- mpz_get_si (f->sym->ts.u.cl->length->value.integer),
- f->sym->name, &a->expr->where);
+ {
+ /* Emit a warning for -std=legacy and an error otherwise. */
+ if (gfc_option.warn_std == 0)
+ gfc_warning (0, "Character length mismatch (%ld/%ld) between "
+ "actual argument and assumed-shape dummy argument "
+ "%qs at %L", actual_len, formal_len,
+ f->sym->name, &a->expr->where);
+ else
+ gfc_error ("Character length mismatch (%ld/%ld) between "
+ "actual argument and assumed-shape dummy argument "
+ "%qs at %L", actual_len, formal_len,
+ f->sym->name, &a->expr->where);
+
+ }
ok = false;
goto match;
}
@@ -3622,21 +3659,74 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap,
gfc_formal_arglist *formal,
if (a->expr->expr_type == EXPR_NULL && a->expr->ts.type == BT_UNKNOWN)
goto skip_size_check;
- actual_size = get_expr_storage_size (a->expr);
- formal_size = get_sym_storage_size (f->sym);
- if (actual_size != 0 && actual_size < formal_size
- && a->expr->ts.type != BT_PROCEDURE
+ actual_size = get_expr_storage_size (a->expr, &actual_size_known);
+ formal_size = get_sym_storage_size (f->sym, &formal_size_known);
+
+ if (actual_size_known && formal_size_known
+ && actual_size != formal_size
+ && a->expr->ts.type == BT_CHARACTER
&& f->sym->attr.flavor != FL_PROCEDURE)
{
- if (a->expr->ts.type == BT_CHARACTER && !f->sym->as && where)
+ /* F2018:15.5.2.4:
+ (3) "The length type parameter values of a present actual argument
+ shall agree with the corresponding ones of the dummy argument that
+ are not assumed, except for the case of the character length
+ parameter of an actual argument of type character with default
+ kind or C character kind associated with a dummy argument that is
+ not assumed-shape or assumed-rank."
+
+ (4) "If a present scalar dummy argument is of type character with
+ default kind or C character kind, the length len of the dummy
+ argument shall be less than or equal to the length of the actual
+ argument. The dummy argument becomes associated with the leftmost
+ len characters of the actual argument. If a present array dummy
+ argument is of type character with default kind or C character
+ kind and is not assumed-shape or assumed-rank, it becomes
+ associated with the leftmost characters of the actual argument
+ element sequence."
+
+ As an extension we treat kind=4 character similarly to kind=1. */
+
+ if (actual_size > formal_size)
{
- gfc_warning (0, "Character length of actual argument shorter "
- "than of dummy argument %qs (%lu/%lu) at %L",
- f->sym->name, actual_size, formal_size,
- &a->expr->where);
+ if (a->expr->ts.type == BT_CHARACTER && where
+ && (!f->sym->as || f->sym->as->type == AS_EXPLICIT))
+ gfc_warning (OPT_Wcharacter_truncation,
+ "Character length of actual argument longer "
+ "than of dummy argument %qs (%lu/%lu) at %L",
+ f->sym->name, actual_size, formal_size,
+ &a->expr->where);
goto skip_size_check;
}
- else if (where)
+
+ if (a->expr->ts.type == BT_CHARACTER && where && !f->sym->as)
+ {
+ /* Emit warning for -std=legacy/gnu and an error otherwise. */
+ if (gfc_notification_std (GFC_STD_LEGACY) == ERROR)
+ {
+ gfc_error ("Character length of actual argument shorter "
+ "than of dummy argument %qs (%lu/%lu) at %L",
+ f->sym->name, actual_size, formal_size,
+ &a->expr->where);
+ ok = false;
+ goto match;
+ }
+ else
+ gfc_warning (0, "Character length of actual argument shorter "
+ "than of dummy argument %qs (%lu/%lu) at %L",
+ f->sym->name, actual_size, formal_size,
+ &a->expr->where);
+ goto skip_size_check;
+ }
+ }
+
+ if (actual_size_known && formal_size_known
+ && actual_size < formal_size
+ && f->sym->as
+ && a->expr->ts.type != BT_PROCEDURE
+ && f->sym->attr.flavor != FL_PROCEDURE)
+ {
+ if (where)
{
/* Emit a warning for -std=legacy and an error otherwise. */
if (gfc_option.warn_std == 0)
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_15.f90
b/gcc/testsuite/gfortran.dg/argument_checking_15.f90
index e79541fcded5..63931a287f2c 100644
--- a/gcc/testsuite/gfortran.dg/argument_checking_15.f90
+++ b/gcc/testsuite/gfortran.dg/argument_checking_15.f90
@@ -45,8 +45,8 @@ subroutine test()
implicit none
character(len=5), pointer :: c
character(len=5) :: str(5)
-call foo(c) ! { dg-warning "Character length mismatch" }
-call bar(str) ! { dg-warning "Character length mismatch" }
+call foo(c) ! { dg-error "Character length mismatch" }
+call bar(str) ! { dg-error "Character length mismatch" }
contains
subroutine foo(a)
character(len=3), pointer :: a
diff --git a/gcc/testsuite/gfortran.dg/argument_checking_27.f90
b/gcc/testsuite/gfortran.dg/argument_checking_27.f90
new file mode 100644
index 000000000000..06dd187dcf98
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/argument_checking_27.f90
@@ -0,0 +1,240 @@
+! { dg-do compile }
+! { dg-additional-options "-std=f2018 -Wcharacter-truncation" }
+! PR fortran/93330
+!
+! Exercise compile-time checking of character length of dummy vs.
+! actual arguments. Based on original testcase by Tobias Burnus
+
+module m
+ use iso_c_binding, only: c_char
+ implicit none
+contains
+ ! scalar dummy
+ ! character(kind=1):
+ subroutine zero(x, y)
+ character(kind=1,len=0), value :: x
+ character(kind=1,len=1), value :: y
+ print '(5a)', 'zero >', x, '< >', y, '<'
+ end
+ subroutine one(x, y)
+ character(kind=1,len=1), value :: x
+ character(kind=1,len=1), value :: y
+ print '(5a)','one >', x, '< >', y, '<'
+ end
+ subroutine two(x, y)
+ character(kind=1,len=2), value :: x
+ character(kind=1,len=1), value :: y
+ print '(5a)','two >', x, '< >', y, '<'
+ end
+ subroutine cbind(x, y) bind(C)
+ character(kind=c_char,len=1), value :: x
+ character(kind=c_char,len=1), value :: y
+ print '(5a)','cbind >', x, '< >', y, '<'
+ end
+
+ ! character(kind=4):
+ subroutine zero4(x, y)
+ character(kind=4,len=0), value :: x
+ character(kind=1,len=1), value :: y
+ print '(5a)', 'zero4 >', x, '< >', y, '<'
+ end
+ subroutine one4(x, y)
+ character(kind=4,len=1), value :: x
+ character(kind=1,len=1), value :: y
+ print '(5a)','one4 >', x, '< >', y, '<'
+ end
+ subroutine two4(x, y)
+ character(kind=4,len=2), value :: x
+ character(kind=1,len=1), value :: y
+ print '(5a)','two4 >', x, '< >', y, '<'
+ end
+
+ ! character(kind=1):
+ ! array dummy, assumed size
+ subroutine zero_0(x, y)
+ character(kind=1,len=0) :: x(*)
+ character(kind=1,len=1), value :: y
+ print '(5a)', 'zero_0 >', x(1), '< >', y, '<'
+ end
+ subroutine one_0(x, y)
+ character(kind=1,len=1) :: x(*)
+ character(kind=1,len=1), value :: y
+ print '(5a)','one_0 >', x(1), '< >', y, '<'
+ end
+ subroutine two_0(x, y)
+ character(kind=1,len=2) :: x(*)
+ character(kind=1,len=1), value :: y
+ print '(5a)','two_0 >', x(1), '< >', y, '<'
+ end
+
+ ! array dummy, explicit size
+ subroutine zero_1(x, y)
+ character(kind=1,len=0) :: x(1)
+ character(kind=1,len=1), value :: y
+ print '(5a)', 'zero_1 >', x(1), '< >', y, '<'
+ end
+ subroutine one_1(x, y)
+ character(kind=1,len=1) :: x(1)
+ character(kind=1,len=1), value :: y
+ print '(5a)','one_1 >', x(1), '< >', y, '<'
+ end
+ subroutine two_1(x, y)
+ character(kind=1,len=2) :: x(1)
+ character(kind=1,len=1), value :: y
+ print '(5a)','two_1 >', x(1), '< >', y, '<'
+ end
+
+ ! array dummy, assumed shape
+ subroutine zero_a(x, y)
+ character(kind=1,len=0) :: x(:)
+ character(kind=1,len=1), value :: y
+ if (size (x) < 1) stop 99
+ print '(5a)', 'zero_a >', x(1), '< >', y, '<'
+ end
+ subroutine one_a(x, y)
+ character(kind=1,len=1) :: x(:)
+ character(kind=1,len=1), value :: y
+ if (size (x) < 1) stop 99
+ print '(5a)','one_a >', x(1), '< >', y, '<'
+ end
+ subroutine two_a(x, y)
+ character(kind=1,len=2) :: x(:)
+ character(kind=1,len=1), value :: y
+ if (size (x) < 1) stop 99
+ print '(5a)','two_a >', x(1), '< >', y, '<'
+ end
+
+ ! character(kind=4):
+ ! array dummy, assumed size
+ subroutine zero4_0(x, y)
+ character(kind=4,len=0) :: x(*)
+ character(kind=4,len=1), value :: y
+ print '(5a)', 'zero4_0 >', x(1), '< >', y, '<'
+ end
+ subroutine one4_0(x, y)
+ character(kind=4,len=1) :: x(*)
+ character(kind=4,len=1), value :: y
+ print '(5a)','one4_0 >', x(1), '< >', y, '<'
+ end
+ subroutine two4_0(x, y)
+ character(kind=4,len=2) :: x(*)
+ character(kind=4,len=1), value :: y
+ print '(5a)','two4_0 >', x(1), '< >', y, '<'
+ end
+
+ ! array dummy, explicit size
+ subroutine zero4_1(x, y)
+ character(kind=4,len=0) :: x(1)
+ character(kind=4,len=1), value :: y
+ print '(5a)', 'zero4_1 >', x(1), '< >', y, '<'
+ end
+ subroutine one4_1(x, y)
+ character(kind=4,len=1) :: x(1)
+ character(kind=4,len=1), value :: y
+ print '(5a)','one4_1 >', x(1), '< >', y, '<'
+ end
+ subroutine two4_1(x, y)
+ character(kind=4,len=2) :: x(1)
+ character(kind=4,len=1), value :: y
+ print '(5a)','two4_1 >', x(1), '< >', y, '<'
+ end
+
+ ! array dummy, assumed shape
+ subroutine zero4_a(x, y)
+ character(kind=4,len=0) :: x(:)
+ character(kind=4,len=1), value :: y
+ if (size (x) < 1) stop 99
+ print '(5a)', 'zero4_a >', x(1), '< >', y, '<'
+ end
+ subroutine one4_a(x, y)
+ character(kind=4,len=1) :: x(:)
+ character(kind=4,len=1), value :: y
+ if (size (x) < 1) stop 99
+ print '(5a)','one4_a >', x(1), '< >', y, '<'
+ end
+ subroutine two4_a(x, y)
+ character(kind=4,len=2) :: x(:)
+ character(kind=4,len=1), value :: y
+ if (size (x) < 1) stop 99
+ print '(5a)','two4_a >', x(1), '< >', y, '<'
+ end
+end
+
+program p
+ use m
+ implicit none
+ call zero('', '1')
+ call one ('', '2') ! { dg-error "length of actual argument shorter" }
+ call one ('b'(3:2),'3') ! { dg-error "length of actual argument shorter" }
+ call two ('', '4') ! { dg-error "length of actual argument shorter" }
+ call two ('f','5') ! { dg-error "length of actual argument shorter" }
+
+ call cbind('', '6') ! { dg-error "length of actual argument shorter" }
+ call cbind('ABC','7') ! { dg-warning "length of actual argument longer" }
+
+ ! character(kind=4):
+ call zero4(4_'', '8')
+ call zero4(4_'3','9') ! { dg-warning "length of actual argument longer"
}
+ call one4 (4_'', 'A') ! { dg-error "length of actual argument shorter" }
+ call one4 (4_'b'(3:2),'B') ! { dg-error "length of actual argument shorter" }
+ call one4 (4_'bbcd'(3:3),'C')
+ call one4 (4_'cd','D') ! { dg-warning "length of actual argument longer"
}
+ call two4 (4_'', 'E') ! { dg-error "length of actual argument shorter" }
+ call two4 (4_'f', 'F') ! { dg-error "length of actual argument shorter" }
+ call two4 (4_'fgh','G') ! { dg-warning "length of actual argument longer"
}
+
+ ! array dummy, assumed size
+ call zero_0([''],'a')
+ call zero_0(['a'],'b')
+ call one_0 ([''],'c')
+ call one_0 (['b'],'d')
+ call one_0 (['cd'],'e')
+ call two_0 ([''],'f')
+ call two_0 (['fg'],'g')
+
+ ! array dummy, explicit size
+ call zero_1([''],'a')
+ call zero_1(['a'],'b') ! { dg-warning "actual argument longer" }
+ call one_1 ([''],'c') ! { dg-error "too few elements for dummy" }
+ call one_1 (['b'],'d')
+ call one_1 (['cd'],'e') ! { dg-warning "actual argument longer" }
+ call two_1 ([''],'f') ! { dg-error "too few elements for dummy" }
+ call two_1 (['fg'],'h')
+
+ ! array dummy, assumed shape
+ call zero_a([''],'a')
+ call zero_a(['a'],'b') ! { dg-error "Character length mismatch" }
+ call one_a ([''],'c') ! { dg-error "Character length mismatch" }
+ call one_a (['b'],'d')
+ call one_a (['cd'],'e') ! { dg-error "Character length mismatch" }
+ call two_a ([''],'f') ! { dg-error "Character length mismatch" }
+ call two_a (['fg'],'h')
+
+ ! character(kind=4):
+ ! array dummy, assumed size
+ call zero4_0([4_''],4_'a')
+ call zero4_0([4_'a'],4_'b')
+ call one4_0 ([4_''],4_'c')
+ call one4_0 ([4_'b'],4_'d')
+ call one4_0 ([4_'cd'],4_'e')
+ call two4_0 ([4_''],4_'f')
+ call two4_0 ([4_'fg'],4_'g')
+
+ ! array dummy, explicit size
+ call zero4_1([4_''],4_'a')
+ call zero4_1([4_'a'],4_'b') ! { dg-warning "actual argument longer" }
+ call one4_1 ([4_''],4_'c') ! { dg-error "too few elements for dummy" }
+ call one4_1 ([4_'b'],4_'d')
+ call one4_1 ([4_'cd'],4_'e') ! { dg-warning "actual argument longer" }
+ call two4_1 ([4_''],4_'f') ! { dg-error "too few elements for dummy" }
+ call two4_1 ([4_'fg'],4_'h')
+
+ ! array dummy, assumed shape
+ call zero4_a([4_''],4_'a')
+ call zero4_a([4_'a'],4_'b') ! { dg-error "Character length mismatch" }
+ call one4_a ([4_''],4_'c') ! { dg-error "Character length mismatch" }
+ call one4_a ([4_'b'],4_'d')
+ call one4_a ([4_'cd'],4_'e') ! { dg-error "Character length mismatch" }
+ call two4_a ([4_''],4_'f') ! { dg-error "Character length mismatch" }
+ call two4_a ([4_'fg'],4_'h')
+end
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_strlen_7.f90
b/gcc/testsuite/gfortran.dg/bounds_check_strlen_7.f90
index 99a0d8697ff6..d8bb8cf6d7c0 100644
--- a/gcc/testsuite/gfortran.dg/bounds_check_strlen_7.f90
+++ b/gcc/testsuite/gfortran.dg/bounds_check_strlen_7.f90
@@ -18,7 +18,8 @@ END MODULE m
PROGRAM main
USE m
IMPLICIT NONE
- CALL test ('') ! 0 length, but not absent argument.
+ ! 0 length, but not absent argument.
+ CALL test ('') ! { dg-warning "Character length of actual argument" }
END PROGRAM main
! { dg-output "shorter than the declared one for dummy argument 'opt'
\\(0/5\\)" }
diff --git a/gcc/testsuite/gfortran.dg/char_length_3.f90
b/gcc/testsuite/gfortran.dg/char_length_3.f90
index 6529a77ff048..75cb43827507 100644
--- a/gcc/testsuite/gfortran.dg/char_length_3.f90
+++ b/gcc/testsuite/gfortran.dg/char_length_3.f90
@@ -1,4 +1,5 @@
! { dg-do compile }
+! { dg-options "-std=legacy" }
! PR fortran/25071
! Check if actual argument is too short
!
diff --git a/gcc/testsuite/gfortran.dg/whole_file_24.f90
b/gcc/testsuite/gfortran.dg/whole_file_24.f90
index 3ff6ca85700f..7b322f1a2158 100644
--- a/gcc/testsuite/gfortran.dg/whole_file_24.f90
+++ b/gcc/testsuite/gfortran.dg/whole_file_24.f90
@@ -27,7 +27,7 @@ module syntax_rules
contains
subroutine syntax_init_from_ifile ()
type(string_t) :: string
- string = line_get_string_advance ("")
+ string = line_get_string_advance ("") ! { dg-warning "Character length
of actual argument shorter" }
end subroutine syntax_init_from_ifile
end module syntax_rules
end
diff --git a/gcc/testsuite/gfortran.dg/whole_file_29.f90
b/gcc/testsuite/gfortran.dg/whole_file_29.f90
index 86d84cf8d27d..87ac4f3041b3 100644
--- a/gcc/testsuite/gfortran.dg/whole_file_29.f90
+++ b/gcc/testsuite/gfortran.dg/whole_file_29.f90
@@ -19,7 +19,7 @@ module syntax_rules
contains
subroutine syntax_init_from_ifile ()
type(string_t) :: string
- string = line_get_string_advance ("")
+ string = line_get_string_advance ("") ! { dg-warning "Character length
of actual argument shorter" }
end subroutine syntax_init_from_ifile
end module syntax_rules
end
