This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.
| Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
|---|---|---|
| Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
| Other format: | [Raw text] | |
PR31293 This PR came about because function results were not obtaining a default type from their own namespaces. This is fixed by calling a function that does this, directly after parsing the specification statements for the program unit. The testcase is James Van Buskirk's interface4.f90. Note that the error in interface1.f90 is missed (variable in a specification statement must have been previously specified) and, with the patch, gfortran compiles this happily (as did LF95, at the time). James' other interface2-4.f90 all compile and run correctly.
PR31424: Here the interface mapping in a function call was picking up a use associated symbol that had not been referenced and consequently hit the buffers in trans-decl.c. The fix is easy - include this case in the gcc-assert. The testcase is the reporter's.
PR31222: This fix adds a search for a default type for arguments of functions in specification expressions that have no type but should. The testcase is the reporter's.
PR30872: This patch fixes a numerical error in finding an element for rank > 1 parameter arrays. The testcase is the reporter's.
PR30880: This was submitted on 2007-03-08. FX found a problem and I have just not had time to correct it since then. See FX's review - http://gcc.gnu.org/ml/fortran/2007-03/msg00352.html
-- Saint Augustine - "O Lord, help me to be pure, but not yet"
Attachment:
submit.msg
Description: Binary data
Index: gcc/fortran/symbol.c
===================================================================
*** gcc/fortran/symbol.c (revision 123382)
--- gcc/fortran/symbol.c (working copy)
*************** gfc_set_default_type (gfc_symbol * sym,
*** 253,258 ****
--- 253,289 ----
}
+ /* This function is called from parse.c(parse_progunit) to check the
+ type of the function is not implicitly typed in the host namespace
+ and to implicitly type the function result, if necessary. */
+
+ void
+ gfc_check_function_type (gfc_namespace *ns)
+ {
+ gfc_symbol *proc = ns->proc_name;
+
+ if (!proc->attr.contained || proc->result->attr.implicit_type)
+ return;
+
+ if (proc->result->ts.type == BT_UNKNOWN)
+ {
+ if (gfc_set_default_type (proc->result, 0, gfc_current_ns)
+ == SUCCESS)
+ {
+ if (proc->result != proc)
+ proc->ts = proc->result->ts;
+ }
+ else
+ {
+ gfc_error ("unable to implicitly type the function result "
+ "'%s' at %L", proc->result->name,
+ &proc->result->declared_at);
+ proc->result->attr.untyped = 1;
+ }
+ }
+ }
+
+
/******************** Symbol attribute stuff *********************/
/* This is a generic conflict-checker. We do this to avoid having a
Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h (revision 123382)
--- gcc/fortran/gfortran.h (working copy)
*************** void gfc_clear_new_implicit (void);
*** 1852,1857 ****
--- 1852,1858 ----
try gfc_add_new_implicit_range (int, int);
try gfc_merge_new_implicit (gfc_typespec *);
void gfc_set_implicit_none (void);
+ void gfc_check_function_type (gfc_namespace *);
gfc_typespec *gfc_get_default_type (gfc_symbol *, gfc_namespace *);
try gfc_set_default_type (gfc_symbol *, int, gfc_namespace *);
Index: gcc/fortran/expr.c
===================================================================
*** gcc/fortran/expr.c (revision 123382)
--- gcc/fortran/expr.c (working copy)
*************** find_array_element (gfc_constructor *con
*** 899,904 ****
--- 899,906 ----
int i;
mpz_t delta;
mpz_t offset;
+ mpz_t span;
+ mpz_t tmp;
gfc_expr *e;
try t;
*************** find_array_element (gfc_constructor *con
*** 907,912 ****
--- 909,916 ----
mpz_init_set_ui (offset, 0);
mpz_init (delta);
+ mpz_init (tmp);
+ mpz_init_set_ui (span, 1);
for (i = 0; i < ar->dimen; i++)
{
e = gfc_copy_expr (ar->start[i]);
*************** find_array_element (gfc_constructor *con
*** 930,936 ****
--- 934,946 ----
}
mpz_sub (delta, e->value.integer, ar->as->lower[i]->value.integer);
+ mpz_mul (delta, delta, span);
mpz_add (offset, offset, delta);
+
+ mpz_set_ui (tmp, 1);
+ mpz_add (tmp, tmp, ar->as->upper[i]->value.integer);
+ mpz_sub (tmp, tmp, ar->as->lower[i]->value.integer);
+ mpz_mul (span, span, tmp);
}
if (cons)
*************** find_array_element (gfc_constructor *con
*** 949,954 ****
--- 959,966 ----
depart:
mpz_clear (delta);
mpz_clear (offset);
+ mpz_clear (span);
+ mpz_clear (tmp);
if (e)
gfc_free_expr (e);
*rval = cons;
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 123382)
--- gcc/fortran/resolve.c (working copy)
*************** resolve_fl_variable (gfc_symbol *sym, in
*** 5648,5654 ****
|| sym->as->upper[i] == NULL
|| sym->as->upper[i]->expr_type != EXPR_CONSTANT)
{
! flag = 1;
break;
}
}
--- 5648,5654 ----
|| sym->as->upper[i] == NULL
|| sym->as->upper[i]->expr_type != EXPR_CONSTANT)
{
! flag = 2;
break;
}
}
*************** resolve_fl_variable (gfc_symbol *sym, in
*** 5670,5676 ****
else if (sym->attr.external)
gfc_error ("External '%s' at %L cannot have an initializer",
sym->name, &sym->declared_at);
! else if (sym->attr.dummy)
gfc_error ("Dummy '%s' at %L cannot have an initializer",
sym->name, &sym->declared_at);
else if (sym->attr.intrinsic)
--- 5670,5677 ----
else if (sym->attr.external)
gfc_error ("External '%s' at %L cannot have an initializer",
sym->name, &sym->declared_at);
! else if (sym->attr.dummy
! && !(sym->ts.type == BT_DERIVED && sym->attr.intent == INTENT_OUT))
gfc_error ("Dummy '%s' at %L cannot have an initializer",
sym->name, &sym->declared_at);
else if (sym->attr.intrinsic)
*************** resolve_fl_variable (gfc_symbol *sym, in
*** 5679,5690 ****
else if (sym->attr.result)
gfc_error ("Function result '%s' at %L cannot have an initializer",
sym->name, &sym->declared_at);
! else
gfc_error ("Automatic array '%s' at %L cannot have an initializer",
sym->name, &sym->declared_at);
return FAILURE;
}
/* Check to see if a derived type is blocked from being host associated
by the presence of another class I symbol in the same namespace.
14.6.1.3 of the standard and the discussion on comp.lang.fortran. */
--- 5680,5694 ----
else if (sym->attr.result)
gfc_error ("Function result '%s' at %L cannot have an initializer",
sym->name, &sym->declared_at);
! else if (flag == 2)
gfc_error ("Automatic array '%s' at %L cannot have an initializer",
sym->name, &sym->declared_at);
+ else
+ goto no_init_error;
return FAILURE;
}
+ no_init_error:
/* Check to see if a derived type is blocked from being host associated
by the presence of another class I symbol in the same namespace.
14.6.1.3 of the standard and the discussion on comp.lang.fortran. */
Index: gcc/fortran/trans-decl.c
===================================================================
*** gcc/fortran/trans-decl.c (revision 123382)
--- gcc/fortran/trans-decl.c (working copy)
*************** gfc_get_symbol_decl (gfc_symbol * sym)
*** 874,880 ****
int byref;
gcc_assert (sym->attr.referenced
! || sym->ns->proc_name->attr.if_source == IFSRC_IFBODY);
if (sym->ns && sym->ns->proc_name->attr.function)
byref = gfc_return_by_reference (sym->ns->proc_name);
--- 874,881 ----
int byref;
gcc_assert (sym->attr.referenced
! || sym->attr.use_assoc
! || sym->ns->proc_name->attr.if_source == IFSRC_IFBODY);
if (sym->ns && sym->ns->proc_name->attr.function)
byref = gfc_return_by_reference (sym->ns->proc_name);
Index: gcc/fortran/parse.c
===================================================================
*** gcc/fortran/parse.c (revision 123382)
--- gcc/fortran/parse.c (working copy)
*************** parse_progunit (gfc_statement st)
*** 2915,2920 ****
--- 2915,2923 ----
break;
}
+ if (gfc_current_state () == COMP_FUNCTION)
+ gfc_check_function_type (gfc_current_ns);
+
loop:
for (;;)
{
Index: gcc/fortran/check.c
===================================================================
*** gcc/fortran/check.c (revision 123382)
--- gcc/fortran/check.c (working copy)
*************** numeric_check (gfc_expr *e, int n)
*** 58,63 ****
--- 58,75 ----
if (gfc_numeric_ts (&e->ts))
return SUCCESS;
+ /* If the expression has not got a type, check if its namespace can
+ offer a default type. */
+ if ((e->expr_type == EXPR_VARIABLE || e->expr_type == EXPR_VARIABLE)
+ && e->symtree->n.sym->ts.type == BT_UNKNOWN
+ && gfc_set_default_type (e->symtree->n.sym, 0,
+ e->symtree->n.sym->ns) == SUCCESS
+ && gfc_numeric_ts (&e->symtree->n.sym->ts))
+ {
+ e->ts = e->symtree->n.sym->ts;
+ return SUCCESS;
+ }
+
gfc_error ("'%s' argument of '%s' intrinsic at %L must be a numeric type",
gfc_current_intrinsic_arg[n], gfc_current_intrinsic, &e->where);
Index: gcc/testsuite/gfortran.dg/used_dummy_types_8.f90
===================================================================
*** gcc/testsuite/gfortran.dg/used_dummy_types_8.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/used_dummy_types_8.f90 (revision 0)
***************
*** 0 ****
--- 1,35 ----
+ ! { dg-do compile }
+ ! Tests the fix for PR30880, in which the variable d1
+ ! in module m1 would cause an error in the main program
+ ! because it has an initializer and is a dummy. This
+ ! came about because the function with multiple entries
+ ! assigns the initializer earlier than for other cases.
+ !
+ ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+ !
+ MODULE M1
+ TYPE T1
+ INTEGER :: i=7
+ END TYPE T1
+ CONTAINS
+ FUNCTION F1(d1) RESULT(res)
+ INTEGER :: res
+ TYPE(T1), INTENT(OUT) :: d1
+ TYPE(T1), INTENT(INOUT) :: d2
+ res=d1%i
+ d1%i=0
+ RETURN
+ ENTRY E1(d2) RESULT(res)
+ res=d2%i
+ d2%i=0
+ END FUNCTION F1
+ END MODULE M1
+
+ USE M1
+ TYPE(T1) :: D1
+ D1=T1(3)
+ write(6,*) F1(D1)
+ D1=T1(3)
+ write(6,*) E1(D1)
+ END
+ ! { dg-final { cleanup-modules "m1" } }
Index: gcc/testsuite/gfortran.dg/unreferenced_use_assoc_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/unreferenced_use_assoc_1.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/unreferenced_use_assoc_1.f90 (revision 0)
***************
*** 0 ****
--- 1,40 ----
+ ! { dg-do compile }
+ ! Tests the fix for PR31424.
+ !
+ module InternalCompilerError
+
+ type Byte
+ private
+ character(len=1) :: singleByte
+ end type
+
+ type (Byte) :: BytesPrototype(1)
+
+ type UserType
+ real :: r
+ end type
+
+ contains
+
+ function UserTypeToBytes(user) result (bytes)
+ type(UserType) :: user
+ type(Byte) :: bytes(size(transfer(user, BytesPrototype)))
+ bytes = transfer(user, BytesPrototype)
+ end function
+
+ subroutine DoSomethingWithBytes(bytes)
+ type(Byte), intent(in) :: bytes(:)
+ end subroutine
+
+ end module
+
+
+ program main
+ use InternalCompilerError
+ type (UserType) :: user
+
+ ! The following line caused the ICE
+ call DoSomethingWithBytes( UserTypeToBytes(user) )
+
+ end program
+ ! { dg-final { cleanup-modules "InternalCompilerError" } }
Index: gcc/testsuite/gfortran.dg/parameter_array_element_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/parameter_array_element_1.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/parameter_array_element_1.f90 (revision 0)
***************
*** 0 ****
--- 1,19 ----
+ ! { dg-do compile}
+ ! { dg-options "-fdump-tree-original" }
+ ! Tests the fix for PR 30872, in which the array element references bo(1,1) etc.
+ ! would be wrong for rank > 1.
+ !
+ ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+ !
+ INTEGER, PARAMETER, DIMENSION(2,3) :: bo= &
+ RESHAPE((/-1,1,-2,2,-3,3/),(/2,3/))
+ REAL(kind=8), DIMENSION( &
+ bo(1,1):bo(2,1), &
+ bo(1,2):bo(2,2), &
+ bo(1,3):bo(2,3)) :: out_val
+ out_val=0.0
+ END
+ ! Scan for the 105 in the declaration real8 out_val[105];
+ ! { dg-final { scan-tree-dump-times "105" 1 "original" } }
+ ! { dg-final { cleanup-tree-dump "original" } }
+
Index: gcc/testsuite/gfortran.dg/default_numeric_type_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/default_numeric_type_1.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/default_numeric_type_1.f90 (revision 0)
***************
*** 0 ****
--- 1,18 ----
+ ! { dg-do compile}
+ ! { dg-options "-fdump-tree-original" }
+ ! Tests the fix for PR 31222, in which the type of the arguments of abs
+ ! and int below were not detected to be of default numeric type..
+ !
+ ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+ !
+ subroutine mysub1(a,b,mode,dis)
+ ! integer :: mode
+ ! real :: dis
+ dimension a(abs(mode)),b(int(dis))
+ print *, mod
+ write (*,*) abs(mode), nint(dis)
+ end subroutine
+
+ program testprog
+ call mysub1((/1.,2./),(/1.,2.,3./),-2, 3.2)
+ end
| Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
|---|---|---|
| Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |