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

re PR fortran/34421 (ENTRY functions: Character with different stringlength not rejected)

Browse Source 
2007-12-23  Tobias Burnus  <burnus@net-b.de>

        PR fortran/34421
        * resolve.c (resolve_entries): Add standard error for functions
        returning characters with different length.

2007-12-23  Tobias Burnus  <burnus@net-b.de>

        PR fortran/34421
        * gfortran.dg/entry_17.f90: New.

From-SVN: r131150
This commit is contained in:
Tobias Burnus 2007-12-23 19:17:08 +01:00 committed by Tobias Burnus
parent 57c65fb59c
commit 107d5ff67f
4 changed files with 85 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2007-12-23 Tobias Burnus <burnus@net-b.de>
PR fortran/34421
* resolve.c (resolve_entries): Add standard error for functions
returning characters with different length.
2007-12-23 Daniel Franke <franke.daniel@gmail.com>
PR fortran/34536

21
gcc/fortran/resolve.c
View File

@ -488,11 +488,28 @@ resolve_entries (gfc_namespace *ns)
|| (el->sym->result->attr.pointer
!= ns->entries->sym->result->attr.pointer))
break;
else if (as && fas && gfc_compare_array_spec (as, fas) == 0)
gfc_error ("Procedure %s at %L has entries with mismatched "
gfc_error ("Function %s at %L has entries with mismatched "
"array specifications", ns->entries->sym->name,
&ns->entries->sym->declared_at);
/* The characteristics need to match and thus both need to have
the same string length, i.e. both len=*, or both len=4.
Having both len=<variable> is also possible, but difficult to
check at compile time. */
else if (ts->type == BT_CHARACTER && ts->cl && fts->cl
&& (((ts->cl->length && !fts->cl->length)
||(!ts->cl->length && fts->cl->length))
|| (ts->cl->length
&& ts->cl->length->expr_type
!= fts->cl->length->expr_type)
|| (ts->cl->length
&& ts->cl->length->expr_type == EXPR_CONSTANT
&& mpz_cmp (ts->cl->length->value.integer,
fts->cl->length->value.integer) != 0)))
gfc_notify_std (GFC_STD_GNU, "Extension: Function %s at %L with "
"entries returning variables of different "
"string lengths", ns->entries->sym->name,
&ns->entries->sym->declared_at);
}
if (el == NULL)

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2007-12-23 Tobias Burnus <burnus@net-b.de>
PR fortran/34421
* gfortran.dg/entry_17.f90: New.
2007-12-23 Daniel Franke <franke.daniel@gmail.com>
PR fortran/34536

55
gcc/testsuite/gfortran.dg/entry_17.f90 Normal file
View File

@ -0,0 +1,55 @@
function test1(n)
integer :: n
character(n) :: test1
character(n) :: bar1
test1 = ""
return
entry bar1()
bar1 = ""
end function test1
function test2()
character(1) :: test2
character(1) :: bar2
test2 = ""
return
entry bar2()
bar2 = ""
end function test2
function test3() ! { dg-warning "is obsolescent" }
character(*) :: test3
character(*) :: bar3 ! { dg-warning "is obsolescent" }
test3 = ""
return
entry bar3()
bar3 = ""
end function test3 ! { dg-warning "is obsolescent" }
function test4(n) ! { dg-error "returning variables of different string lengths" }
integer :: n
character(n) :: test4
character(*) :: bar4 ! { dg-warning "is obsolescent" }
test4 = ""
return
entry bar4()
bar4 = ""
end function test4
function test5() ! { dg-error "returning variables of different string lengths" }
character(1) :: test5
character(2) :: bar5
test5 = ""
return
entry bar5()
bar5 = ""
end function test5
function test6() ! { dg-warning "is obsolescent|returning variables of different string lengths" }
character(*) :: test6
character(2) :: bar6
test6 = ""
return
entry bar6()
bar6 = ""
end function test6 ! { dg-warning "is obsolescent" }