[Bug fortran/15809] ICE Using Pointer Functions
paul dot richard dot thomas at cea dot fr
gcc-bugzilla@gcc.gnu.org
Wed Nov 23 14:26:00 GMT 2005
------- Comment #18 from paul dot richard dot thomas at cea dot fr 2005-11-23 14:26 -------
(In reply to comment #15)
> I cannot tell why, but it seems to me that Paul Thomas' test case is no valid
Hej Sven!
You quite correctly picked up that it does not have an explicit interface and
so will give nonsense. Making it contained or writing an interface converts my
rubbish into legal code.
I have made progress in converting pointer arrays into references to pointer
arrays:
The patch below works for pointer assignments with integers and characters and
returns pointer dummy arguments correctly.
There is still a problem (seg fault) with assignments of characters. This comes
about because dtype does not contain the size, as is apparent from the code at
the end of the message. (see the dtypes in the subroutine).
There are also some issues with alignment during pointer assignments.
This damn thing is going to work, legal fortran or not!!!!
Both the examples below work.
Paul Thomas 23rd Nov 2005
Danger: Cygwin source => whitespace issues.
*** trunk/gcc/fortran/trans-array.c Wed Nov 23 14:44:18 2005
--- trunk/gcc/fortran/trans-array.c.orig Wed Nov 23 14:45:15 2005
*************** gfc_trans_deferred_array (gfc_symbol * s
*** 4173,4179 ****
gfc_init_block (&fnblock);
! gcc_assert (TREE_CODE (sym->backend_decl) == VAR_DECL);
if (sym->ts.type == BT_CHARACTER
&& !INTEGER_CST_P (sym->ts.cl->backend_decl))
gfc_trans_init_string_length (sym->ts.cl, &fnblock);
--- 4173,4181 ----
gfc_init_block (&fnblock);
! gcc_assert (TREE_CODE (sym->backend_decl) == VAR_DECL
! || TREE_CODE (sym->backend_decl) == PARM_DECL);
!
if (sym->ts.type == BT_CHARACTER
&& !INTEGER_CST_P (sym->ts.cl->backend_decl))
gfc_trans_init_string_length (sym->ts.cl, &fnblock);
*** trunk/gcc/fortran/trans-expr.c Wed Nov 23 14:55:20 2005
--- trunk/gcc/fortran/trans-expr.c.orig Wed Nov 23 14:56:37 2005
*************** gfc_conv_variable (gfc_se * se, gfc_expr
*** 396,401 ****
--- 396,404 ----
|| !sym->attr.dimension))
se->expr = gfc_build_indirect_ref (se->expr);
}
+
+ if (sym->attr.pointer && sym->attr.dummy && sym->attr.dimension)
+ se->expr = gfc_build_indirect_ref (se->expr);
ref = expr->ref;
}
*************** gfc_conv_function_call (gfc_se * se, gfc
*** 1608,1614 ****
&& !formal->sym->attr.pointer
&& formal->sym->as->type != AS_ASSUMED_SHAPE;
f = f || !sym->attr.always_explicit;
! gfc_conv_array_parameter (&parmse, arg->expr, argss, f);
}
}
--- 1611,1619 ----
&& !formal->sym->attr.pointer
&& formal->sym->as->type != AS_ASSUMED_SHAPE;
f = f || !sym->attr.always_explicit;
! gfc_conv_array_parameter (&parmse, arg->expr, argss, f);
! if (formal != NULL && formal->sym->attr.pointer &&
formal->sym->attr.dimension)
! parmse.expr = gfc_build_addr_expr (NULL, parmse.expr);
}
}
*** trunk/gcc/fortran/trans-types.c Wed Nov 23 13:48:37 2005
--- trunk/gcc/fortran/trans-types.c.orig Wed Nov 23 13:49:06 2005
*************** gfc_sym_type (gfc_symbol * sym)
*** 1333,1338 ****
--- 1333,1342 ----
}
else
type = gfc_build_array_type (type, sym->as);
+
+ if (sym->attr.pointer && sym->attr.dummy)
+ type = build_reference_type (type);
+
}
else
{
!=============================================================================
module global
CHARACTER(14), DIMENSION(2), target :: t
end module global
program oh_no_not_pr15908_again
CHARACTER(12), DIMENSION(:), POINTER :: ptr
allocate (ptr(2))
ptr = "xyz"
call a (ptr, 12)
IF ( .NOT. ASSOCIATED(ptr) ) THEN
print *, "not associated in MAIN"
else
print *, "associated in MAIN ", size(ptr,1), len (ptr), ptr
END IF
contains
SUBROUTINE A(p, l)
use global
CHARACTER(l), DIMENSION(:), POINTER :: p
t = "abc"
IF ( .NOT. ASSOCIATED(p) ) THEN
p => t
print *, "not associated in A ", size(p,1), len (p), p
else
print *, "associated in A ", size(p,1), len (p), p
t = "lmn"
p => t
END IF
END SUBROUTINE A
end program oh_no_not_pr15908_again
!=========================integer version=========================
module global
integer, DIMENSION(2), target :: t
end module global
integer, DIMENSION(:), POINTER :: ptr
allocate (ptr(2))
ptr = 123
IF ( .NOT. ASSOCIATED(ptr) ) THEN
print *, "not associated in MAIN"
else
print *, "associated in MAIN ", size(ptr,1), ptr
END IF
call a (ptr, 12)
IF ( .NOT. ASSOCIATED(ptr) ) THEN
print *, "not associated in MAIN"
else
print *, "associated in MAIN ", size(ptr,1), ptr
END IF
contains
SUBROUTINE A(p, l)
use global
integer, DIMENSION(:), POINTER :: p
t = 456
IF ( .NOT. ASSOCIATED(p) ) THEN
p => t
print *, "not associated in A ", size(p,1), p
else
print *, "associated in A ", size(p,1), p
t = 789
p => t
print *, "associated in A ", size(p,1), p
END IF
END SUBROUTINE A
end
=========================code for character version====================
a (p, l, _p)
{
extern char t[2][1:14];
int4 .p;
.p = *l;
{
int4 S.0;
S.0 = 1;
while (1)
{
if (S.0 > 2) goto L.1; else (void) 0;
_gfortran_copy_string (14, &t[NON_LVALUE_EXPR <S.0> + -1], 3, "abc");
S.0 = S.0 + 1;
}
L.1:;
}
if ((char[0:][1:] *) (*p)->data != 0B == 0)
{
(*p)->dtype = 49;
(*p)->dim[0].lbound = 1;
(*p)->dim[0].ubound = 2;
(*p)->dim[0].stride = 1;
(*p)->data = (void *) (char[0:][1:14] *) &t[0];
(*p)->offset = -1;
_gfortran_filename = "pr15809.f90";
_gfortran_line = 24;
_gfortran_ioparm.unit = 6;
_gfortran_ioparm.list_format = 1;
_gfortran_st_write ();
_gfortran_transfer_character ("not associated in A ", 22);
{
int4 D.577;
D.577 = _gfortran_size1 ((struct array1_unknown *) *p, 1);
_gfortran_transfer_integer (&D.577, 4);
}
{
int4 D.578;
D.578 = .p;
_gfortran_transfer_integer (&D.578, 4);
}
_gfortran_transfer_array ((struct array1_unknown *) *p, 1, .p);
_gfortran_st_write_done ();
}
else
{
_gfortran_filename = "pr15809.f90";
_gfortran_line = 26;
_gfortran_ioparm.unit = 6;
_gfortran_ioparm.list_format = 1;
_gfortran_st_write ();
_gfortran_transfer_character ("associated in A ", 22);
{
int4 D.579;
D.579 = _gfortran_size1 ((struct array1_unknown *) *p, 1);
_gfortran_transfer_integer (&D.579, 4);
}
{
int4 D.580;
D.580 = .p;
_gfortran_transfer_integer (&D.580, 4);
}
_gfortran_transfer_array ((struct array1_unknown *) *p, 1, .p);
_gfortran_st_write_done ();
{
int4 S.1;
S.1 = 1;
while (1)
{
if (S.1 > 2) goto L.2; else (void) 0;
_gfortran_copy_string (14, &t[NON_LVALUE_EXPR <S.1> + -1], 3,
"lmn";
S.1 = S.1 + 1;
}
L.2:;
}
(*p)->dtype = 49;
(*p)->dim[0].lbound = 1;
(*p)->dim[0].ubound = 2;
(*p)->dim[0].stride = 1;
(*p)->data = (void *) (char[0:][1:14] *) &t[0];
(*p)->offset = -1;
}
}
MAIN__ ()
{
struct array1_unknown ptr;
static void a (struct array1_unknown & &, int4 &, int4);
ptr.data = 0B;
{
void * * D.584;
ptr.dtype = 1585;
ptr.dim[0].lbound = 1;
ptr.dim[0].ubound = 2;
ptr.dim[0].stride = 1;
D.584 = &ptr.data;
_gfortran_allocate (D.584, 48, 0);
ptr.offset = -1;
}
{
int4 D.587;
int4 D.586;
char[0:][1:24] * D.585;
D.585 = (char[0:][1:24] *) ptr.data;
D.586 = ptr.offset;
D.587 = ptr.dim[0].lbound;
{
int4 D.589;
int4 S.2;
D.589 = ptr.dim[0].stride;
S.2 = D.587;
while (1)
{
if (S.2 > ptr.dim[0].ubound) goto L.3; else (void) 0;
_gfortran_copy_string (24, &(*D.585)[NON_LVALUE_EXPR <S.2> * D.589 +
.586], 3, "xyz");
S.2 = S.2 + 1;
}
L.3:;
}
}
{
int4 C.591 = 12;
a (&&ptr, &C.591, 24);
}
if ((char[0:][1:24] *) ptr.data != 0B == 0)
{
_gfortran_filename = "pr15809.f90";
_gfortran_line = 11;
_gfortran_ioparm.unit = 6;
_gfortran_ioparm.list_format = 1;
_gfortran_st_write ();
_gfortran_transfer_character ("not associated in MAIN", 22);
_gfortran_st_write_done ();
}
else
{
_gfortran_filename = "pr15809.f90";
_gfortran_line = 13;
_gfortran_ioparm.unit = 6;
_gfortran_ioparm.list_format = 1;
_gfortran_st_write ();
_gfortran_transfer_character ("associated in MAIN ", 22);
{
int4 D.592;
D.592 = _gfortran_size1 (&ptr, 1);
_gfortran_transfer_integer (&D.592, 4);
}
{
int4 C.593 = 24;
_gfortran_transfer_integer (&C.593, 4);
}
_gfortran_transfer_array (&ptr, 1, 24);
_gfortran_st_write_done ();
}
}
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=15809
More information about the Gcc-bugs
mailing list