2010-11-02 Steven G.
2010-11-02 Steven G. Kargl < kargl@gcc.gnu.org> Tobias Burnus <burnus@net-b.de> PR fortran/45170 * array.c (gfc_match_array_constructor): Reject deferred type parameter (DTP) in type-spec. * decl.c (char_len_param_value, match_char_length, gfc_match_char_spec, build_sym, variable_decl, enumerator_decl): Support DTP. * expr.c (check_inquiry): Fix check due to support for DTP. * gfortran.h (gfc_typespec): Add Boolean 'deferred'. * misc.c (gfc_clear_ts): Set it to false. * match.c (gfc_match_allocate): Support DTP. * resolve.c (resolve_allocate_expr): Not-implemented error for * DTP. (resolve_fl_variable): Add DTP constraint check. * trans-decl.c (gfc_trans_deferred_vars): Add not-implemented error for DTP. 2010-11-02 Steven G. Kargl < kargl@gcc.gnu.org> Tobias Burnus <burnus@net-b.de> PR fortran/45170 * gfortran.dg/deferred_type_param_1.f90: New. * gfortran.dg/deferred_type_param_2.f90: New. * gfortran.dg/initialization_1.f90: Update dg-errors. * gfortran.dg/initialization_9.f90: Update dg-errors. Co-Authored-By: Tobias Burnus <burnus@net-b.de> From-SVN: r166205
This commit is contained in:
parent
343b2efcd7
commit
e69afb29dc
|
@ -1,3 +1,21 @@
|
|||
2010-11-02 Steven G. Kargl < kargl@gcc.gnu.org>
|
||||
Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/45170
|
||||
* array.c (gfc_match_array_constructor): Reject deferred type
|
||||
parameter (DTP) in type-spec.
|
||||
* decl.c (char_len_param_value, match_char_length,
|
||||
gfc_match_char_spec, build_sym, variable_decl,
|
||||
enumerator_decl): Support DTP.
|
||||
* expr.c (check_inquiry): Fix check due to support for DTP.
|
||||
* gfortran.h (gfc_typespec): Add Boolean 'deferred'.
|
||||
* misc.c (gfc_clear_ts): Set it to false.
|
||||
* match.c (gfc_match_allocate): Support DTP.
|
||||
* resolve.c (resolve_allocate_expr): Not-implemented error for DTP.
|
||||
(resolve_fl_variable): Add DTP constraint check.
|
||||
* trans-decl.c (gfc_trans_deferred_vars): Add not-implemented
|
||||
error for DTP.
|
||||
|
||||
2010-11-01 Steven G. Kargl <kargl@gcc.gnu.org>
|
||||
|
||||
PR fortran/46152
|
||||
|
|
|
@ -1035,6 +1035,13 @@ gfc_match_array_constructor (gfc_expr **result)
|
|||
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Array constructor "
|
||||
"including type specification at %C") == FAILURE)
|
||||
goto cleanup;
|
||||
|
||||
if (ts.deferred)
|
||||
{
|
||||
gfc_error ("Type-spec at %L cannot contain a deferred "
|
||||
"type parameter", &where);
|
||||
goto cleanup;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
@ -647,16 +647,27 @@ match_intent_spec (void)
|
|||
|
||||
|
||||
/* Matches a character length specification, which is either a
|
||||
specification expression or a '*'. */
|
||||
specification expression, '*', or ':'. */
|
||||
|
||||
static match
|
||||
char_len_param_value (gfc_expr **expr)
|
||||
char_len_param_value (gfc_expr **expr, bool *deferred)
|
||||
{
|
||||
match m;
|
||||
|
||||
if (gfc_match_char ('*') == MATCH_YES)
|
||||
{
|
||||
*expr = NULL;
|
||||
*deferred = false;
|
||||
|
||||
if (gfc_match_char ('*') == MATCH_YES)
|
||||
return MATCH_YES;
|
||||
|
||||
if (gfc_match_char (':') == MATCH_YES)
|
||||
{
|
||||
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: deferred type "
|
||||
"parameter at %C") == FAILURE)
|
||||
return MATCH_ERROR;
|
||||
|
||||
*deferred = true;
|
||||
|
||||
return MATCH_YES;
|
||||
}
|
||||
|
||||
|
@ -697,11 +708,12 @@ syntax:
|
|||
char_len_param_value in parenthesis. */
|
||||
|
||||
static match
|
||||
match_char_length (gfc_expr **expr)
|
||||
match_char_length (gfc_expr **expr, bool *deferred)
|
||||
{
|
||||
int length;
|
||||
match m;
|
||||
|
||||
*deferred = false;
|
||||
m = gfc_match_char ('*');
|
||||
if (m != MATCH_YES)
|
||||
return m;
|
||||
|
@ -722,7 +734,7 @@ match_char_length (gfc_expr **expr)
|
|||
if (gfc_match_char ('(') == MATCH_NO)
|
||||
goto syntax;
|
||||
|
||||
m = char_len_param_value (expr);
|
||||
m = char_len_param_value (expr, deferred);
|
||||
if (m != MATCH_YES && gfc_matching_function)
|
||||
{
|
||||
gfc_undo_symbols ();
|
||||
|
@ -1086,7 +1098,7 @@ verify_c_interop_param (gfc_symbol *sym)
|
|||
/* Function called by variable_decl() that adds a name to the symbol table. */
|
||||
|
||||
static gfc_try
|
||||
build_sym (const char *name, gfc_charlen *cl,
|
||||
build_sym (const char *name, gfc_charlen *cl, bool cl_deferred,
|
||||
gfc_array_spec **as, locus *var_locus)
|
||||
{
|
||||
symbol_attribute attr;
|
||||
|
@ -1103,7 +1115,10 @@ build_sym (const char *name, gfc_charlen *cl,
|
|||
return FAILURE;
|
||||
|
||||
if (sym->ts.type == BT_CHARACTER)
|
||||
{
|
||||
sym->ts.u.cl = cl;
|
||||
sym->ts.deferred = cl_deferred;
|
||||
}
|
||||
|
||||
/* Add dimension attribute if present. */
|
||||
if (gfc_set_array_spec (sym, *as, var_locus) == FAILURE)
|
||||
|
@ -1710,6 +1725,7 @@ variable_decl (int elem)
|
|||
gfc_array_spec *as;
|
||||
gfc_array_spec *cp_as; /* Extra copy for Cray Pointees. */
|
||||
gfc_charlen *cl;
|
||||
bool cl_deferred;
|
||||
locus var_locus;
|
||||
match m;
|
||||
gfc_try t;
|
||||
|
@ -1770,10 +1786,11 @@ variable_decl (int elem)
|
|||
|
||||
char_len = NULL;
|
||||
cl = NULL;
|
||||
cl_deferred = false;
|
||||
|
||||
if (current_ts.type == BT_CHARACTER)
|
||||
{
|
||||
switch (match_char_length (&char_len))
|
||||
switch (match_char_length (&char_len, &cl_deferred))
|
||||
{
|
||||
case MATCH_YES:
|
||||
cl = gfc_new_charlen (gfc_current_ns, NULL);
|
||||
|
@ -1794,6 +1811,8 @@ variable_decl (int elem)
|
|||
else
|
||||
cl = current_ts.u.cl;
|
||||
|
||||
cl_deferred = current_ts.deferred;
|
||||
|
||||
break;
|
||||
|
||||
case MATCH_ERROR:
|
||||
|
@ -1869,7 +1888,7 @@ variable_decl (int elem)
|
|||
create a symbol for those yet. If we fail to create the symbol,
|
||||
bail out. */
|
||||
if (gfc_current_state () != COMP_DERIVED
|
||||
&& build_sym (name, cl, &as, &var_locus) == FAILURE)
|
||||
&& build_sym (name, cl, cl_deferred, &as, &var_locus) == FAILURE)
|
||||
{
|
||||
m = MATCH_ERROR;
|
||||
goto cleanup;
|
||||
|
@ -2277,16 +2296,18 @@ gfc_match_char_spec (gfc_typespec *ts)
|
|||
gfc_charlen *cl;
|
||||
gfc_expr *len;
|
||||
match m;
|
||||
bool deferred;
|
||||
|
||||
len = NULL;
|
||||
seen_length = 0;
|
||||
kind = 0;
|
||||
is_iso_c = 0;
|
||||
deferred = false;
|
||||
|
||||
/* Try the old-style specification first. */
|
||||
old_char_selector = 0;
|
||||
|
||||
m = match_char_length (&len);
|
||||
m = match_char_length (&len, &deferred);
|
||||
if (m != MATCH_NO)
|
||||
{
|
||||
if (m == MATCH_YES)
|
||||
|
@ -2315,7 +2336,7 @@ gfc_match_char_spec (gfc_typespec *ts)
|
|||
if (gfc_match (" , len =") == MATCH_NO)
|
||||
goto rparen;
|
||||
|
||||
m = char_len_param_value (&len);
|
||||
m = char_len_param_value (&len, &deferred);
|
||||
if (m == MATCH_NO)
|
||||
goto syntax;
|
||||
if (m == MATCH_ERROR)
|
||||
|
@ -2328,7 +2349,7 @@ gfc_match_char_spec (gfc_typespec *ts)
|
|||
/* Try to match "LEN = <len-param>" or "LEN = <len-param>, KIND = <int>". */
|
||||
if (gfc_match (" len =") == MATCH_YES)
|
||||
{
|
||||
m = char_len_param_value (&len);
|
||||
m = char_len_param_value (&len, &deferred);
|
||||
if (m == MATCH_NO)
|
||||
goto syntax;
|
||||
if (m == MATCH_ERROR)
|
||||
|
@ -2348,7 +2369,7 @@ gfc_match_char_spec (gfc_typespec *ts)
|
|||
}
|
||||
|
||||
/* Try to match ( <len-param> ) or ( <len-param> , [ KIND = ] <int> ). */
|
||||
m = char_len_param_value (&len);
|
||||
m = char_len_param_value (&len, &deferred);
|
||||
if (m == MATCH_NO)
|
||||
goto syntax;
|
||||
if (m == MATCH_ERROR)
|
||||
|
@ -2407,6 +2428,7 @@ done:
|
|||
|
||||
ts->u.cl = cl;
|
||||
ts->kind = kind == 0 ? gfc_default_character_kind : kind;
|
||||
ts->deferred = deferred;
|
||||
|
||||
/* We have to know if it was a c interoperable kind so we can
|
||||
do accurate type checking of bind(c) procs, etc. */
|
||||
|
@ -7449,7 +7471,7 @@ enumerator_decl (void)
|
|||
/* OK, we've successfully matched the declaration. Now put the
|
||||
symbol in the current namespace. If we fail to create the symbol,
|
||||
bail out. */
|
||||
if (build_sym (name, NULL, &as, &var_locus) == FAILURE)
|
||||
if (build_sym (name, NULL, false, &as, &var_locus) == FAILURE)
|
||||
{
|
||||
m = MATCH_ERROR;
|
||||
goto cleanup;
|
||||
|
|
|
@ -2292,10 +2292,13 @@ check_inquiry (gfc_expr *e, int not_restricted)
|
|||
with LEN, as required by the standard. */
|
||||
if (i == 5 && not_restricted
|
||||
&& ap->expr->symtree->n.sym->ts.type == BT_CHARACTER
|
||||
&& ap->expr->symtree->n.sym->ts.u.cl->length == NULL)
|
||||
&& (ap->expr->symtree->n.sym->ts.u.cl->length == NULL
|
||||
|| ap->expr->symtree->n.sym->ts.deferred))
|
||||
{
|
||||
gfc_error ("Assumed character length variable '%s' in constant "
|
||||
"expression at %L", e->symtree->n.sym->name, &e->where);
|
||||
gfc_error ("Assumed or deferred character length variable '%s' "
|
||||
" in constant expression at %L",
|
||||
ap->expr->symtree->n.sym->name,
|
||||
&ap->expr->where);
|
||||
return MATCH_ERROR;
|
||||
}
|
||||
else if (not_restricted && check_init_expr (ap->expr) == FAILURE)
|
||||
|
|
|
@ -885,7 +885,7 @@ typedef struct gfc_charlen
|
|||
struct gfc_charlen *next;
|
||||
bool length_from_typespec; /* Length from explicit array ctor typespec? */
|
||||
tree backend_decl;
|
||||
tree passed_length; /* Length argument explicitelly passed. */
|
||||
tree passed_length; /* Length argument explicitly passed. */
|
||||
|
||||
int resolved;
|
||||
}
|
||||
|
@ -911,6 +911,7 @@ typedef struct
|
|||
int is_c_interop;
|
||||
int is_iso_c;
|
||||
bt f90_type;
|
||||
bool deferred;
|
||||
}
|
||||
gfc_typespec;
|
||||
|
||||
|
|
|
@ -2845,12 +2845,12 @@ gfc_match_allocate (void)
|
|||
gfc_typespec ts;
|
||||
gfc_symbol *sym;
|
||||
match m;
|
||||
locus old_locus;
|
||||
bool saw_stat, saw_errmsg, saw_source, saw_mold, b1, b2, b3;
|
||||
locus old_locus, deferred_locus;
|
||||
bool saw_stat, saw_errmsg, saw_source, saw_mold, saw_deferred, b1, b2, b3;
|
||||
|
||||
head = tail = NULL;
|
||||
stat = errmsg = source = mold = tmp = NULL;
|
||||
saw_stat = saw_errmsg = saw_source = saw_mold = false;
|
||||
saw_stat = saw_errmsg = saw_source = saw_mold = saw_deferred = false;
|
||||
|
||||
if (gfc_match_char ('(') != MATCH_YES)
|
||||
goto syntax;
|
||||
|
@ -2879,6 +2879,13 @@ gfc_match_allocate (void)
|
|||
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: typespec in "
|
||||
"ALLOCATE at %L", &old_locus) == FAILURE)
|
||||
goto cleanup;
|
||||
|
||||
if (ts.deferred)
|
||||
{
|
||||
gfc_error ("Type-spec at %L cannot contain a deferred "
|
||||
"type parameter", &old_locus);
|
||||
goto cleanup;
|
||||
}
|
||||
}
|
||||
else
|
||||
{
|
||||
|
@ -2912,6 +2919,12 @@ gfc_match_allocate (void)
|
|||
goto cleanup;
|
||||
}
|
||||
|
||||
if (tail->expr->ts.deferred)
|
||||
{
|
||||
saw_deferred = true;
|
||||
deferred_locus = tail->expr->where;
|
||||
}
|
||||
|
||||
/* The ALLOCATE statement had an optional typespec. Check the
|
||||
constraints. */
|
||||
if (ts.type != BT_UNKNOWN)
|
||||
|
@ -3095,7 +3108,6 @@ alloc_opt_list:
|
|||
break;
|
||||
}
|
||||
|
||||
|
||||
if (gfc_match (" )%t") != MATCH_YES)
|
||||
goto syntax;
|
||||
|
||||
|
@ -3107,6 +3119,14 @@ alloc_opt_list:
|
|||
goto cleanup;
|
||||
}
|
||||
|
||||
/* Check F03:C623, */
|
||||
if (saw_deferred && ts.type == BT_UNKNOWN && !source)
|
||||
{
|
||||
gfc_error ("Allocate-object at %L with a deferred type parameter "
|
||||
"requires either a type-spec or SOURCE tag", &deferred_locus);
|
||||
goto cleanup;
|
||||
}
|
||||
|
||||
new_st.op = EXEC_ALLOCATE;
|
||||
new_st.expr1 = stat;
|
||||
new_st.expr2 = errmsg;
|
||||
|
|
|
@ -77,6 +77,7 @@ gfc_clear_ts (gfc_typespec *ts)
|
|||
ts->f90_type = BT_UNKNOWN;
|
||||
/* flag that says whether it's from iso_c_binding or not */
|
||||
ts->is_iso_c = 0;
|
||||
ts->deferred = false;
|
||||
}
|
||||
|
||||
|
||||
|
|
|
@ -6856,6 +6856,12 @@ check_symbols:
|
|||
}
|
||||
|
||||
success:
|
||||
if (e->ts.deferred)
|
||||
{
|
||||
gfc_error ("Support for entity at %L with deferred type parameter "
|
||||
"not yet implemented", &e->where);
|
||||
return FAILURE;
|
||||
}
|
||||
return SUCCESS;
|
||||
|
||||
failure:
|
||||
|
@ -9371,6 +9377,7 @@ resolve_index_expr (gfc_expr *e)
|
|||
return SUCCESS;
|
||||
}
|
||||
|
||||
|
||||
/* Resolve a charlen structure. */
|
||||
|
||||
static gfc_try
|
||||
|
@ -9684,6 +9691,7 @@ apply_default_init_local (gfc_symbol *sym)
|
|||
build_init_assign (sym, init);
|
||||
}
|
||||
|
||||
|
||||
/* Resolution of common features of flavors variable and procedure. */
|
||||
|
||||
static gfc_try
|
||||
|
@ -9847,12 +9855,22 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
|
|||
return FAILURE;
|
||||
}
|
||||
|
||||
/* Constraints on deferred type parameter. */
|
||||
if (sym->ts.deferred && !(sym->attr.pointer || sym->attr.allocatable))
|
||||
{
|
||||
gfc_error ("Entity '%s' at %L has a deferred type parameter and "
|
||||
"requires either the pointer or allocatable attribute",
|
||||
sym->name, &sym->declared_at);
|
||||
return FAILURE;
|
||||
}
|
||||
|
||||
if (sym->ts.type == BT_CHARACTER)
|
||||
{
|
||||
/* Make sure that character string variables with assumed length are
|
||||
dummy arguments. */
|
||||
e = sym->ts.u.cl->length;
|
||||
if (e == NULL && !sym->attr.dummy && !sym->attr.result)
|
||||
if (e == NULL && !sym->attr.dummy && !sym->attr.result
|
||||
&& !sym->ts.deferred)
|
||||
{
|
||||
gfc_error ("Entity with assumed character length at %L must be a "
|
||||
"dummy argument or a PARAMETER", &sym->declared_at);
|
||||
|
|
|
@ -3416,6 +3416,8 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
|
|||
gfc_add_init_cleanup (block, gfc_finish_block (&init), tmp);
|
||||
}
|
||||
}
|
||||
else if (sym->ts.deferred)
|
||||
gfc_fatal_error ("Deferred type parameter not yet supported");
|
||||
else if (sym_has_alloc_comp)
|
||||
gfc_trans_deferred_array (sym, block);
|
||||
else if (sym->ts.type == BT_CHARACTER)
|
||||
|
|
|
@ -1,3 +1,12 @@
|
|||
2010-11-02 Steven G. Kargl < kargl@gcc.gnu.org>
|
||||
Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/45170
|
||||
* gfortran.dg/deferred_type_param_1.f90: New.
|
||||
* gfortran.dg/deferred_type_param_2.f90: New.
|
||||
* gfortran.dg/initialization_1.f90: Update dg-errors.
|
||||
* gfortran.dg/initialization_9.f90: Update dg-errors.
|
||||
|
||||
2010-11-02 Richard Guenther <rguenther@suse.de>
|
||||
|
||||
PR tree-optimization/46149
|
||||
|
|
|
@ -23,7 +23,7 @@ subroutine implicit_none_test1
|
|||
allocate(real(8) :: x4(1)) ! { dg-error "differs from the kind type parameter" }
|
||||
allocate(real(4) :: x8(1)) ! { dg-error "differs from the kind type parameter" }
|
||||
allocate(double :: d1(1)) ! { dg-error "Error in type-spec at" }
|
||||
allocate(character(:) :: c1(1)) ! { dg-error "Syntax error in CHARACTER declaration" }
|
||||
allocate(character(:) :: c1(1)) ! { dg-error "cannot contain a deferred type parameter" }
|
||||
allocate(real :: b(1)) ! { dg-error "is type incompatible" }
|
||||
|
||||
end subroutine implicit_none_test1
|
||||
|
@ -50,7 +50,7 @@ subroutine implicit_none_test2
|
|||
allocate(real(8) :: x4) ! { dg-error "differs from the kind type parameter" }
|
||||
allocate(real(4) :: x8) ! { dg-error "differs from the kind type parameter" }
|
||||
allocate(double :: d1) ! { dg-error "Error in type-spec at" }
|
||||
allocate(character(:) :: c1) ! { dg-error "Syntax error in CHARACTER declaration" }
|
||||
allocate(character(:) :: c1) ! { dg-error "cannot contain a deferred type parameter" }
|
||||
allocate(real :: b) ! { dg-error "is type incompatible" }
|
||||
|
||||
end subroutine implicit_none_test2
|
||||
|
@ -76,7 +76,7 @@ subroutine implicit_test3
|
|||
allocate(real(8) :: x4(1)) ! { dg-error "differs from the kind type parameter" }
|
||||
allocate(real(4) :: x8(1)) ! { dg-error "differs from the kind type parameter" }
|
||||
allocate(double :: d1(1)) ! { dg-error "Error in type-spec" }
|
||||
allocate(character(:) :: c1(1)) ! { dg-error "Syntax error in CHARACTER declaration" }
|
||||
allocate(character(:) :: c1(1)) ! { dg-error "cannot contain a deferred type parameter" }
|
||||
allocate(real :: b(1)) ! { dg-error "is type incompatible" }
|
||||
|
||||
end subroutine implicit_test3
|
||||
|
@ -101,7 +101,7 @@ subroutine implicit_test4
|
|||
allocate(real(8) :: x4) ! { dg-error "differs from the kind type parameter" }
|
||||
allocate(real(4) :: x8) ! { dg-error "differs from the kind type parameter" }
|
||||
allocate(double :: d1) ! { dg-error "Error in type-spec at" }
|
||||
allocate(character(:) :: c1) ! { dg-error "Syntax error in CHARACTER declaration" }
|
||||
allocate(character(:) :: c1) ! { dg-error "cannot contain a deferred type parameter" }
|
||||
allocate(real :: b) ! { dg-error "is type incompatible" }
|
||||
|
||||
end subroutine implicit_test4
|
||||
|
|
|
@ -0,0 +1,12 @@
|
|||
! { dg-do compile }
|
||||
! { dg-options "-std=f95" }
|
||||
!
|
||||
! PR fortran/45170
|
||||
!
|
||||
! Character deferred type parameter
|
||||
!
|
||||
implicit none
|
||||
character(len=:), allocatable :: str(:) ! { dg-error "Fortran 2003: deferred type parameter" }
|
||||
|
||||
character(len=4) :: str2*(:) ! { dg-error "Fortran 2003: deferred type parameter" }
|
||||
end
|
|
@ -0,0 +1,62 @@
|
|||
! { dg-do compile }
|
||||
! { dg-options "-std=f2008" }
|
||||
!
|
||||
! PR fortran/45170
|
||||
!
|
||||
! Character deferred type parameter
|
||||
!
|
||||
|
||||
subroutine one(x, y) ! { dg-error "Entity .y. at .1. has a deferred type parameter" }
|
||||
implicit none
|
||||
character(len=:), pointer :: x
|
||||
character(len=:) :: y
|
||||
character(len=:), allocatable, target :: str2
|
||||
character(len=:), target :: str ! { dg-error "deferred type parameter" }
|
||||
end subroutine one
|
||||
|
||||
subroutine two()
|
||||
implicit none
|
||||
character(len=:), allocatable, target :: str1(:)
|
||||
character(len=5), save, target :: str2
|
||||
character(len=:), pointer :: pstr => str2
|
||||
character(len=:), pointer :: pstr2(:)
|
||||
end subroutine two
|
||||
|
||||
subroutine three()
|
||||
! implicit none ! Disabled because of PR 46152
|
||||
character(len=:), allocatable, target :: str1(:)
|
||||
character(len=5), save, target :: str2
|
||||
character(len=:), pointer :: pstr
|
||||
character(len=:), pointer :: pstr2(:)
|
||||
|
||||
pstr => str2
|
||||
pstr2 => str1
|
||||
str1 = ["abc"]
|
||||
pstr2 => str1
|
||||
|
||||
allocate (character(len=77) :: str1(1)) ! OK ! { dg-error "not yet implemented" }
|
||||
allocate (pstr, source=str2) ! OK ! { dg-error "not yet implemented" }
|
||||
allocate (pstr, mold=str2) ! { dg-error "requires either a type-spec or SOURCE tag" }
|
||||
allocate (pstr) ! { dg-error "requires either a type-spec or SOURCE tag" }
|
||||
allocate (character(len=:) :: str1(1)) ! { dg-error "cannot contain a deferred type parameter" }
|
||||
|
||||
str1 = [ character(len=2) :: "abc" ]
|
||||
str1 = [ character(len=:) :: "abc" ] ! { dg-error "cannot contain a deferred type parameter" }
|
||||
end subroutine three
|
||||
|
||||
subroutine four()
|
||||
implicit none
|
||||
character(len=:), allocatable, target :: str
|
||||
character(len=:), pointer :: pstr
|
||||
pstr => str
|
||||
str = "abc"
|
||||
if(len(pstr) /= len(str) .or. len(str)/= 3) call abort()
|
||||
str = "abcd"
|
||||
if(len(pstr) /= len(str) .or. len(str)/= 4) call abort()
|
||||
end subroutine four
|
||||
|
||||
subroutine five()
|
||||
character(len=4) :: str*(:)
|
||||
allocatable :: str
|
||||
end subroutine five
|
||||
|
|
@ -24,7 +24,7 @@ contains
|
|||
real :: z(2, 2)
|
||||
|
||||
! However, this gives a warning because it is an initialization expression.
|
||||
integer :: l1 = len (ch1) ! { dg-warning "Assumed character length variable" }
|
||||
integer :: l1 = len (ch1) ! { dg-warning "Assumed or deferred character length variable" }
|
||||
|
||||
! These are warnings because they are gfortran extensions.
|
||||
integer :: m3 = size (x, 1) ! { dg-error "Assumed size array" }
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
|
||||
integer function xstrcmp(s1)
|
||||
character*(*), intent(in) :: s1
|
||||
integer :: n1 = len(s1) ! { dg-error "Assumed character length variable" }
|
||||
integer :: n1 = len(s1) ! { dg-error "Assumed or deferred character length variable" }
|
||||
n1 = 1
|
||||
return
|
||||
end function xstrcmp
|
||||
|
|
Loading…
Reference in New Issue