OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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:
Steven G. Kargl 2010-11-02 17:09:58 +00:00 committed by Tobias Burnus
parent 343b2efcd7
commit e69afb29dc
15 changed files with 205 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
gcc/fortran/ChangeLog
View File

@ -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

7
gcc/fortran/array.c
View File

@ -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;
}
}
}

50
gcc/fortran/decl.c
View File

@ -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;
*expr = NULL;
*deferred = false;
if (gfc_match_char ('*') == MATCH_YES)
return MATCH_YES;
if (gfc_match_char (':') == MATCH_YES)
{
*expr = NULL;
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.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;

9
gcc/fortran/expr.c
View File

@ -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)

5
gcc/fortran/gfortran.h
View File

@ -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;
}
@ -910,7 +910,8 @@ typedef struct
struct gfc_symbol *interface; /* For PROCEDURE declarations. */
int is_c_interop;
int is_iso_c;
bt f90_type;
bt f90_type;
bool deferred;
}
gfc_typespec;

28
gcc/fortran/match.c
View File

@ -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;
@ -3106,6 +3118,14 @@ alloc_opt_list:
&mold->where, &source->where);
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;

1
gcc/fortran/misc.c
View File

@ -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;
}

20
gcc/fortran/resolve.c
View File

@ -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);

2
gcc/fortran/trans-decl.c
View File

@ -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)

9
gcc/testsuite/ChangeLog
View File

@ -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

8
gcc/testsuite/gfortran.dg/allocate_with_typespec_3.f90
View File

@ -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

12
gcc/testsuite/gfortran.dg/deferred_type_param_1.f90 Normal file
View File

@ -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

62
gcc/testsuite/gfortran.dg/deferred_type_param_2.f90 Normal file
View File

@ -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

2
gcc/testsuite/gfortran.dg/initialization_1.f90
View File

@ -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" }

2
gcc/testsuite/gfortran.dg/initialization_9.f90
View File

@ -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