This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
Re: Regressions
- From: Paul Thomas <paulthomas2 at wanadoo dot fr>
- To: Steve Kargl <sgk at troutmask dot apl dot washington dot edu>
- Cc: fortran at gcc dot gnu dot org
- Date: Fri, 14 Jul 2006 10:26:18 +0200
- Subject: Re: Regressions
- References: <20060713212047.GA26643@troutmask.apl.washington.edu>
Steve,
FAIL: gfortran.dg/actual_array_substr_2.f90 -O0 (test for excess errors)
Excess errors:
FAIL: gfortran.dg/interface_derived_type_1.f90 -O (test for errors, line 16)
FAIL: gfortran.dg/present_1.f90 -O (test for errors, line 14)
These are all tests added in my last patch or, in the case of the first,
de-regressed by it. However, I have taken diffs(attached) of both
patches, as applied to trunk, and both look clean and mutually
independent. I am a bit baffled.
Incidentally, don't expect a great response from "Old Europe" - today is
Bastille Day. We partied last night, to watch the fireworks, and,
well.... I will take the holiday VERY slowly.
Cheers
Paul
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c (revision 115371)
--- gcc/fortran/trans-expr.c (revision 115372)
*************** Software Foundation, 51 Franklin Street,
*** 31,36 ****
--- 31,37 ----
#include "toplev.h"
#include "real.h"
#include "tree-gimple.h"
+ #include "langhooks.h"
#include "flags.h"
#include "gfortran.h"
#include "trans.h"
*************** gfc_trans_string_copy (stmtblock_t * blo
*** 2233,2238 ****
--- 2234,2244 ----
tree dsc;
tree ssc;
tree cond;
+ tree cond2;
+ tree tmp2;
+ tree tmp3;
+ tree tmp4;
+ stmtblock_t tempblock;
/* Deal with single character specially. */
dsc = gfc_to_single_character (dlen, dest);
*************** gfc_trans_string_copy (stmtblock_t * blo
*** 2243,2257 ****
return;
}
cond = fold_build2 (GT_EXPR, boolean_type_node, dlen,
build_int_cst (gfc_charlen_type_node, 0));
! tmp = NULL_TREE;
! tmp = gfc_chainon_list (tmp, dlen);
! tmp = gfc_chainon_list (tmp, dest);
! tmp = gfc_chainon_list (tmp, slen);
! tmp = gfc_chainon_list (tmp, src);
! tmp = build_function_call_expr (gfor_fndecl_copy_string, tmp);
tmp = fold_build3 (COND_EXPR, void_type_node, cond, tmp, build_empty_stmt ());
gfc_add_expr_to_block (block, tmp);
}
--- 2249,2311 ----
return;
}
+ /* Do nothing if the destination length is zero. */
cond = fold_build2 (GT_EXPR, boolean_type_node, dlen,
build_int_cst (gfc_charlen_type_node, 0));
! /* The following code was previously in _gfortran_copy_string:
!
! // The two strings may overlap so we use memmove.
! void
! copy_string (GFC_INTEGER_4 destlen, char * dest,
! GFC_INTEGER_4 srclen, const char * src)
! {
! if (srclen >= destlen)
! {
! // This will truncate if too long.
! memmove (dest, src, destlen);
! }
! else
! {
! memmove (dest, src, srclen);
! // Pad with spaces.
! memset (&dest[srclen], ' ', destlen - srclen);
! }
! }
!
! We're now doing it here for better optimization, but the logic
! is the same. */
!
! /* Truncate string if source is too long. */
! cond2 = fold_build2 (GE_EXPR, boolean_type_node, slen, dlen);
! tmp2 = gfc_chainon_list (NULL_TREE, dest);
! tmp2 = gfc_chainon_list (tmp2, src);
! tmp2 = gfc_chainon_list (tmp2, dlen);
! tmp2 = build_function_call_expr (built_in_decls[BUILT_IN_MEMMOVE], tmp2);
!
! /* Else copy and pad with spaces. */
! tmp3 = gfc_chainon_list (NULL_TREE, dest);
! tmp3 = gfc_chainon_list (tmp3, src);
! tmp3 = gfc_chainon_list (tmp3, slen);
! tmp3 = build_function_call_expr (built_in_decls[BUILT_IN_MEMMOVE], tmp3);
!
! tmp4 = fold_build2 (PLUS_EXPR, pchar_type_node, dest,
! fold_convert (pchar_type_node, slen));
! tmp4 = gfc_chainon_list (NULL_TREE, tmp4);
! tmp4 = gfc_chainon_list (tmp4, build_int_cst
! (gfc_get_int_type (gfc_c_int_kind),
! lang_hooks.to_target_charset (' ')));
! tmp4 = gfc_chainon_list (tmp4, fold_build2 (MINUS_EXPR, TREE_TYPE(dlen),
! dlen, slen));
! tmp4 = build_function_call_expr (built_in_decls[BUILT_IN_MEMSET], tmp4);
!
! gfc_init_block (&tempblock);
! gfc_add_expr_to_block (&tempblock, tmp3);
! gfc_add_expr_to_block (&tempblock, tmp4);
! tmp3 = gfc_finish_block (&tempblock);
!
! /* The whole copy_string function is there. */
! tmp = fold_build3 (COND_EXPR, void_type_node, cond2, tmp2, tmp3);
tmp = fold_build3 (COND_EXPR, void_type_node, cond, tmp, build_empty_stmt ());
gfc_add_expr_to_block (block, tmp);
}
Index: gcc/fortran/ChangeLog
===================================================================
*** gcc/fortran/ChangeLog (revision 115371)
--- gcc/fortran/ChangeLog (revision 115372)
***************
*** 1,3 ****
--- 1,12 ----
+ 2006-07-12 Francois-Xavier Coudert <coudert@clipper.ens.fr>
+
+ PR fortran/28163
+ * trans-expr.c (gfc_trans_string_copy): Generate inline code
+ to perform string copying instead of calling a library function.
+ * trans-decl.c (gfc_build_intrinsic_function_decls): Don't build
+ decl for copy_string.
+ * trans.h (gfor_fndecl_copy_string): Remove prototype.
+
2006-07-11 Feng Wang <fengwang@nudt.edu.cn>
PR fortran/28213
Index: gcc/fortran/trans.h
===================================================================
*** gcc/fortran/trans.h (revision 115371)
--- gcc/fortran/trans.h (revision 115372)
*************** extern GTY(()) tree gfor_fndecl_math_exp
*** 508,514 ****
extern GTY(()) tree gfor_fndecl_math_exponent16;
/* String functions. */
- extern GTY(()) tree gfor_fndecl_copy_string;
extern GTY(()) tree gfor_fndecl_compare_string;
extern GTY(()) tree gfor_fndecl_concat_string;
extern GTY(()) tree gfor_fndecl_string_len_trim;
--- 508,513 ----
Index: gcc/fortran/trans-decl.c
===================================================================
*** gcc/fortran/trans-decl.c (revision 115371)
--- gcc/fortran/trans-decl.c (revision 115372)
*************** tree gfor_fndecl_math_exponent16;
*** 121,127 ****
/* String functions. */
- tree gfor_fndecl_copy_string;
tree gfor_fndecl_compare_string;
tree gfor_fndecl_concat_string;
tree gfor_fndecl_string_len_trim;
--- 121,126 ----
*************** gfc_build_intrinsic_function_decls (void
*** 1938,1950 ****
tree gfc_c_int_type_node = gfc_get_int_type (gfc_c_int_kind);
/* String functions. */
- gfor_fndecl_copy_string =
- gfc_build_library_function_decl (get_identifier (PREFIX("copy_string")),
- void_type_node,
- 4,
- gfc_charlen_type_node, pchar_type_node,
- gfc_charlen_type_node, pchar_type_node);
-
gfor_fndecl_compare_string =
gfc_build_library_function_decl (get_identifier (PREFIX("compare_string")),
gfc_int4_type_node,
--- 1937,1942 ----
Index: libgfortran/intrinsics/string_intrinsics.c
===================================================================
*** libgfortran/intrinsics/string_intrinsics.c (revision 115371)
--- libgfortran/intrinsics/string_intrinsics.c (revision 115372)
*************** Boston, MA 02110-1301, USA. */
*** 44,52 ****
/* String functions. */
- extern void copy_string (GFC_INTEGER_4, char *, GFC_INTEGER_4, const char *);
- export_proto(copy_string);
-
extern void concat_string (GFC_INTEGER_4, char *,
GFC_INTEGER_4, const char *,
GFC_INTEGER_4, const char *);
--- 44,49 ----
*************** export_proto(string_trim);
*** 79,104 ****
extern void string_repeat (char *, GFC_INTEGER_4, const char *, GFC_INTEGER_4);
export_proto(string_repeat);
- /* The two areas may overlap so we use memmove. */
-
- void
- copy_string (GFC_INTEGER_4 destlen, char * dest,
- GFC_INTEGER_4 srclen, const char * src)
- {
- if (srclen >= destlen)
- {
- /* This will truncate if too long. */
- memmove (dest, src, destlen);
- }
- else
- {
- memmove (dest, src, srclen);
- /* Pad with spaces. */
- memset (&dest[srclen], ' ', destlen - srclen);
- }
- }
-
-
/* Strings of unequal length are extended with pad characters. */
GFC_INTEGER_4
--- 76,81 ----
Index: libgfortran/ChangeLog
===================================================================
*** libgfortran/ChangeLog (revision 115371)
--- libgfortran/ChangeLog (revision 115372)
***************
*** 1,3 ****
--- 1,8 ----
+ 2006-07-12 Francois-Xavier Coudert <coudert@clipper.ens.fr>
+
+ PR fortran/28163
+ * intrinsics/string_intrinsics.c (copy_string): Remove function.
+
2006-07-04 Francois-Xavier Coudert <coudert@clipper.ens.fr>
* intrinsics/date_and_time.c (itime0,idate0,itime_i4,itime_i8,
Index: gcc/testsuite/ChangeLog
===================================================================
*** gcc/testsuite/ChangeLog (revision 115409)
--- gcc/testsuite/ChangeLog (revision 115410)
***************
*** 1,3 ****
--- 1,11 ----
+ 2006-07-13 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/25097
+ * gfortran.dg/present_1.f90: New test.
+
+ PR fortran/20903
+ * gfortran.dg/interface_derived_type_1.f90: New test.
+
2006-07-11 Feng Wang <fengwang@nudt.edu.cn>
PR fortran/28213
Index: gcc/testsuite/gfortran.dg/interface_derived_type_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/interface_derived_type_1.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/interface_derived_type_1.f90 (revision 115410)
***************
*** 0 ****
--- 1,54 ----
+ ! { dg-do compile }
+ ! Test the fix for PR20903, in which derived types could be host associated within
+ ! interface bodies.
+ !
+ ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+ !
+ module test
+ implicit none
+ type fcnparms
+ integer :: i
+ end type fcnparms
+ contains
+ subroutine sim_1(func1,params)
+ interface
+ function func1(fparams)
+ type(fcnparms) :: fparams ! { dg-error "not been declared within the interface" }
+ real :: func1
+ end function func1
+ end interface
+ type(fcnparms) :: params
+ end subroutine sim_1
+
+ subroutine sim_2(func2,params)
+ interface
+ function func2(fparams) ! This is OK because of the derived type decl.
+ type fcnparms
+ integer :: i
+ end type fcnparms
+ type(fcnparms) :: fparams
+ real :: func2
+ end function func2
+ end interface
+ type(fcnparms) :: params ! This is OK, of course
+ end subroutine sim_2
+ end module test
+
+ module type_decl
+ implicit none
+ type fcnparms
+ integer :: i
+ end type fcnparms
+ end module type_decl
+
+ subroutine sim_3(func3,params)
+ use type_decl
+ interface
+ function func3(fparams)
+ use type_decl
+ type(fcnparms) :: fparams ! This is OK - use associated
+ real :: func3
+ end function func3
+ end interface
+ type(fcnparms) :: params ! -ditto-
+ end subroutine sim_3
Index: gcc/testsuite/gfortran.dg/present_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/present_1.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/present_1.f90 (revision 115410)
***************
*** 0 ****
--- 1,20 ----
+ ! { dg-do compile }
+ ! Test the fix for PR25097, in which subobjects of the optional dummy argument
+ ! could appear as argument A of the PRESENT intrinsic.
+ !
+ ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+ !
+ MODULE M1
+ TYPE T1
+ INTEGER :: I
+ END TYPE T1
+ CONTAINS
+ SUBROUTINE S1(D1)
+ TYPE(T1), OPTIONAL :: D1(4)
+ write(6,*) PRESENT(D1%I) ! { dg-error "must not be a sub-object" }
+ write(6,*) PRESENT(D1(1)) ! { dg-error "must not be a sub-object" }
+ write(6,*) PRESENT(D1)
+ END SUBROUTINE S1
+ END MODULE
+ END
+
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c (revision 115409)
--- gcc/fortran/trans-expr.c (revision 115410)
*************** gfc_conv_function_call (gfc_se * se, gfc
*** 1981,1987 ****
array of derived types. In this case, the argument
is converted to a temporary, which is passed and then
written back after the procedure call. */
! gfc_conv_aliased_arg (&parmse, e, f, fsym->attr.intent);
else
gfc_conv_array_parameter (&parmse, e, argss, f);
--- 1981,1988 ----
array of derived types. In this case, the argument
is converted to a temporary, which is passed and then
written back after the procedure call. */
! gfc_conv_aliased_arg (&parmse, e, f,
! fsym ? fsym->attr.intent : INTENT_INOUT);
else
gfc_conv_array_parameter (&parmse, e, argss, f);
Index: gcc/fortran/decl.c
===================================================================
*** gcc/fortran/decl.c (revision 115409)
--- gcc/fortran/decl.c (revision 115410)
*************** variable_decl (int elem)
*** 1176,1181 ****
--- 1176,1195 ----
goto cleanup;
}
+ /* An interface body specifies all of the procedure's characteristics and these
+ shall be consistent with those specified in the procedure definition, except
+ that the interface may specify a procedure that is not pure if the procedure
+ is defined to be pure(12.3.2). */
+ if (current_ts.type == BT_DERIVED
+ && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY
+ && current_ts.derived->ns != gfc_current_ns)
+ {
+ gfc_error ("the type of '%s' at %C has not been declared within the "
+ "interface", name);
+ m = MATCH_ERROR;
+ goto cleanup;
+ }
+
/* In functions that have a RESULT variable defined, the function
name always refers to function calls. Therefore, the name is
not allowed to appear in specification statements. */
Index: gcc/fortran/ChangeLog
===================================================================
*** gcc/fortran/ChangeLog (revision 115409)
--- gcc/fortran/ChangeLog (revision 115410)
***************
*** 1,3 ****
--- 1,18 ----
+ 006-07-13 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/28174
+ * trans-expr.c (gfc_conv_aliased_arg): Missing formal arg means
+ that intent is INOUT (fixes regression).
+
+ PR fortran/25097
+ * check.c (check_present): The only permitted reference is a
+ full array reference.
+
+ PR fortran/20903
+ * decl.c (variable_decl): Add error if a derived type is not
+ from the current namespace if the namespace is an interface
+ body.
+
2006-07-12 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR fortran/28163
Index: gcc/fortran/check.c
===================================================================
*** gcc/fortran/check.c (revision 115409)
--- gcc/fortran/check.c (revision 115410)
*************** gfc_check_present (gfc_expr * a)
*** 1867,1872 ****
--- 1867,1888 ----
return FAILURE;
}
+ /* 13.14.82 PRESENT(A)
+ ......
+ Argument. A shall be the name of an optional dummy argument that is accessible
+ in the subprogram in which the PRESENT function reference appears... */
+
+ if (a->ref != NULL
+ && !(a->ref->next == NULL
+ && a->ref->type == REF_ARRAY
+ && a->ref->u.ar.type == AR_FULL))
+ {
+ gfc_error ("'%s' argument of '%s' intrinsic at %L must not be a sub-"
+ "object of '%s'", gfc_current_intrinsic_arg[0],
+ gfc_current_intrinsic, &a->where, sym->name);
+ return FAILURE;
+ }
+
return SUCCESS;
}