mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-08 20:52:05 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/41044 (internal compiler error: in gfc_conv_intrinsic_function)

Browse Source 
2010-01-24  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/41044
	PR fortran/41167
	* expr.c (remove_subobject_ref): If the constructor is NULL use
	the expression as the source.
	(simplify_const_ref): Change the type of expression if
	there are component references.  Allow for substring to be at
	the end of an arbitrarily long chain of references.  If an
	element is found that is not in an EXPR_ARRAY, assume that this
	is scalar initialization of array. Call remove_subobject_ref in
	this case with NULL second argument.

2010-01-24  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/41044
	* gfortran.dg/parameter_array_ref_2.f90 : New test.

	PR fortran/41167
	* gfortran.dg/char_array_arg_1.f90 : New test.

	* gfortran.dg/pr25923.f90 : Remove XFAIL.

From-SVN: r156197
This commit is contained in:
Paul Thomas 2010-01-24 16:59:51 +00:00
parent 23f6293ee8
commit ff015c5b6c
6 changed files with 112 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
gcc/fortran/ChangeLog
View File

@ -1,3 +1,16 @@
2010-01-24 Paul Thomas <pault@gcc.gnu.org>
PR fortran/41044
PR fortran/41167
* expr.c (remove_subobject_ref): If the constructor is NULL use
the expression as the source.
(simplify_const_ref): Change the type of expression if
there are component references. Allow for substring to be at
the end of an arbitrarily long chain of references. If an
element is found that is not in an EXPR_ARRAY, assume that this
is scalar initialization of array. Call remove_subobject_ref in
this case with NULL second argument.
2010-01-24 Tobias Burnus <burnus@net-b.de>
PR fortran/39304

44
gcc/fortran/expr.c
View File

@ -1154,8 +1154,13 @@ remove_subobject_ref (gfc_expr *p, gfc_constructor *cons)
{
gfc_expr *e;
e = cons->expr;
cons->expr = NULL;
if (cons)
{
e = cons->expr;
cons->expr = NULL;
}
else
e = gfc_copy_expr (p);
e->ref = p->ref->next;
p->ref->next = NULL;
gfc_replace_expr (p, e);
@ -1464,6 +1469,7 @@ simplify_const_ref (gfc_expr *p)
{
gfc_constructor *cons;
gfc_expr *newp;
gfc_ref *last_ref;
while (p->ref)
{
@ -1473,6 +1479,13 @@ simplify_const_ref (gfc_expr *p)
switch (p->ref->u.ar.type)
{
case AR_ELEMENT:
/* <type/kind spec>, parameter :: x(<int>) = scalar_expr
will generate this. */
if (p->expr_type != EXPR_ARRAY)
{
remove_subobject_ref (p, NULL);
break;
}
if (find_array_element (p->value.constructor, &p->ref->u.ar,
&cons) == FAILURE)
return FAILURE;
@ -1502,18 +1515,25 @@ simplify_const_ref (gfc_expr *p)
return FAILURE;
}
/* If this is a CHARACTER array and we possibly took a
substring out of it, update the type-spec's character
length according to the first element (as all should have
the same length). */
if (p->ts.type == BT_CHARACTER)
if (p->ts.type == BT_DERIVED
&& p->ref->next
&& p->value.constructor)
{
/* There may have been component references. */
p->ts = p->value.constructor->expr->ts;
}
last_ref = p->ref;
for (; last_ref->next; last_ref = last_ref->next) {};
if (p->ts.type == BT_CHARACTER
&& last_ref->type == REF_SUBSTRING)
{
/* If this is a CHARACTER array and we possibly took
a substring out of it, update the type-spec's
character length according to the first element
(as all should have the same length). */
int string_len;
gcc_assert (p->ref->next);
gcc_assert (!p->ref->next->next);
gcc_assert (p->ref->next->type == REF_SUBSTRING);
if (p->value.constructor)
{
const gfc_expr* first = p->value.constructor->expr;

10
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,13 @@
2010-01-24 Paul Thomas <pault@gcc.gnu.org>
PR fortran/41044
* gfortran.dg/parameter_array_ref_2.f90 : New test.
PR fortran/41167
* gfortran.dg/char_array_arg_1.f90 : New test.
* gfortran.dg/pr25923.f90 : Remove XFAIL.
2010-01-24 Tobias Burnus <burnus@net-b.de>
PR fortran/39304

17
gcc/testsuite/gfortran.dg/char_array_arg_1.f90 Normal file
View File

@ -0,0 +1,17 @@
! { dg-do compile }
! Test the fix for pr41167, in which the first argument of 'pack', below,
! was simplified incorrectly, with the results indicated.
!
! Contributed by Harald Anlauf <anlauf@gmx.de>
!
program gfcbug88
implicit none
type t
character(len=8) :: name
end type t
type(t) ,parameter :: obstyp(2)= (/ t ('A'), t ('B') /)
character(9) :: chr(1)
print *, pack (" "//obstyp(:)% name, (/ .true., .false. /)) ! Used to ICE on compilation
chr = pack (" "//obstyp(:)% name, (/ .true., .false. /)) ! Used to give conversion error
end program gfcbug88

39
gcc/testsuite/gfortran.dg/parameter_array_ref_2.f90 Normal file
View File

@ -0,0 +1,39 @@
! { dg-do compile }
! Test the fix for the problems in PR41044
!
! Contributed by <ros@rzg.mpg.de>
! Reduced by Joos VandeVondele <jv244@cam.ac.uk>
!
Subroutine PS_INIT (bkgd, punit, pform, psize, rot90, bbox, clip, eps, &
caller)
type psfd ! paper size and frame defaults
character(3) :: n
real :: p(2)
real :: f(4)
end type psfd
character(4) :: fn, orich, pfmt
type(psfd), parameter :: pfd(0:11)=(/ &
psfd(' ',(/ 0.0, 0.0/),(/200.,120.,800.,560./)), & ! A0_L
psfd('A0 ',(/ 840.9,1189.2/),(/140., 84.,560.,400./)), & ! A0_P
psfd('A1 ',(/ 594.6, 840.9/),(/100., 60.,400.,280./)), & ! A1_P
psfd('A2 ',(/ 420.4, 594.6/),(/ 70., 42.,280.,200./)), & ! A2_P
psfd('A3 ',(/ 297.3, 420.4/),(/ 50., 30.,200.,140./)), & ! A3_P
psfd('A4 ',(/ 210.2, 297.3/),(/ 35., 21.,140.,100./)), & ! A4_P
psfd('A5 ',(/ 148.7, 210.2/),(/ 25., 15.,100., 70./)), & ! A5_P
psfd('A6 ',(/ 105.1, 148.7/),(/ 18., 11., 70., 50./)), & ! A6_P
psfd(' ',(/ 0.0, 0.0/),(/ 50., 30.,200.,140./)), & ! Letter_L
psfd('LET',(/ 215.9, 279.4/),(/ 35., 21.,140.,100./)), & ! Letter_P
psfd(' ',(/ 0.0, 0.0/),(/ 50., 30.,200.,140./)), & ! Legal_L
psfd('LEG',(/ 215.9, 355.6/),(/ 35., 21.,140.,100./))/) ! Legal_P
if (len_trim(pfmt) > 0) then ! set paper format
idx=sum(maxloc(index(pfd%n,pfmt(1:3))))-1
end if
end subroutine PS_INIT
! This, additional problem, was posted as comment #8 by Tobias Burnus <burnus@gcc.gnu.org>
type t
integer :: i
end type t
type(t), parameter :: a(1) = t(4) ! [t(4)] worked OK
real(a(1)%i) :: b
end

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

@ -10,7 +10,7 @@ implicit none
contains
function baz(arg) result(res) ! { dg-warning "res.yr' may be" "" { xfail *-*-* } }
function baz(arg) result(res) ! { dg-warning "res.yr' may be" }
type(bar), intent(in) :: arg
type(bar) :: res
logical, external:: some_func