PING: [Patch, fortran] PR fortran/96724 - Bogus warnings with the repeat intrinsic and the flag -Wconversion-extra
*PING*
Forwarded Message
Subject: [Patch, fortran] PR fortran/96724 - Bogus warnings with the
repeat intrinsic and the flag -Wconversion-extra
Date: Thu, 20 Aug 2020 16:52:10 +
From: José Rui Faustino de Sousa
To: fortran@gcc.gnu.org, gcc-patc...@gcc.gnu.org
Hi all!
Proposed patch to PR96724 - Bogus warnings with the repeat intrinsic and
the flag -Wconversion-extra.
Patch tested only on x86_64-pc-linux-gnu.
Add code to force conversion to the default wider integer type before
multiplication.
Thank you very much.
Best regards,
José Rui
2020-8-20 José Rui Faustino de Sousa
PR fortran/96724
* iresolve.c (gfc_resolve_repeat): Force conversion to
gfc_index_integer_kind before the call to gfc_multiply.
2020-8-20 José Rui Faustino de Sousa
PR fortran/96724
* repeat_8.f90.f90: New test.
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 7376961..74075a7 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -2332,7 +2332,22 @@ gfc_resolve_repeat (gfc_expr *f, gfc_expr *string,
}
if (tmp)
-f->ts.u.cl->length = gfc_multiply (tmp, gfc_copy_expr (ncopies));
+{
+ gfc_expr *e = gfc_copy_expr (ncopies);
+
+ /* Force-convert to index_kind so that we don't need
+ so many runtime variations. */
+ if (e->ts.kind != gfc_index_integer_kind)
+ {
+ gfc_typespec ts = e->ts;
+
+ ts.kind = gfc_index_integer_kind;
+ gfc_convert_type_warn (e, &ts, 2, 0);
+ }
+ if (tmp->ts.kind != gfc_index_integer_kind)
+ gfc_convert_type_warn (tmp, &e->ts, 2, 0);
+ f->ts.u.cl->length = gfc_multiply (tmp, e);
+}
}
diff --git a/gcc/testsuite/gfortran.dg/repeat_8.f90 b/gcc/testsuite/gfortran.dg/repeat_8.f90
new file mode 100644
index 000..6876af9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/repeat_8.f90
@@ -0,0 +1,88 @@
+! { dg-do compile }
+! { dg-additional-options "-Wconversion-extra" }
+!
+! Test fix for PR96724
+!
+
+program repeat_p
+
+ use, intrinsic :: iso_fortran_env, only: &
+int8, int16, int32, int64
+
+ implicit none
+
+ integer, parameter :: n = 20
+
+ integer(kind=int8), parameter :: p08 = int(n, kind=int8)
+ integer(kind=int16), parameter :: p16 = int(n, kind=int16)
+ integer(kind=int16), parameter :: p32 = int(n, kind=int32)
+ integer(kind=int16), parameter :: p64 = int(n, kind=int64)
+
+ integer(kind=int8) :: i08
+ integer(kind=int16) :: i16
+ integer(kind=int32) :: i32
+ integer(kind=int64) :: i64
+
+ character(len=n) :: c
+
+ i08 = p08
+ c = repeat('X', 20_int8)
+ c = repeat('X', i08)
+ c = repeat('X', p08)
+ c = repeat('X', len08(c))
+ i16 = p16
+ c = repeat('X', 20_int16)
+ c = repeat('X', i16)
+ c = repeat('X', p16)
+ c = repeat('X', len16(c))
+ i32 = p32
+ c = repeat('X', 20_int32)
+ c = repeat('X', i32)
+ c = repeat('X', p32)
+ c = repeat('X', len32(c))
+ i64 = p64
+ c = repeat('X', 20_int64)
+ c = repeat('X', i64)
+ c = repeat('X', p64)
+ c = repeat('X', len64(c))
+ stop
+
+contains
+
+ function len08(x) result(l)
+character(len=*), intent(in) :: x
+
+integer(kind=int8) :: l
+
+l = int(len(x), kind=int8)
+return
+ end function len08
+
+ function len16(x) result(l)
+character(len=*), intent(in) :: x
+
+integer(kind=int16) :: l
+
+l = int(len(x), kind=int16)
+return
+ end function len16
+
+ function len32(x) result(l)
+character(len=*), intent(in) :: x
+
+integer(kind=int32) :: l
+
+l = int(len(x), kind=int32)
+return
+ end function len32
+
+ function len64(x) result(l)
+character(len=*), intent(in) :: x
+
+integer(kind=int64) :: l
+
+l = int(len(x), kind=int64)
+return
+ end function len64
+
+end program repeat_p
PING: [Patch, fortran] PR fortran/96870 - Class name on error message
*PING*
Forwarded Message
Subject: [Patch, fortran] PR fortran/96870 - Class name on error message
Date: Mon, 31 Aug 2020 16:09:32 +
From: José Rui Faustino de Sousa
To: fortran@gcc.gnu.org, gcc-patc...@gcc.gnu.org
Hi all!
Proposed patch to PR96870 - Class name on error message.
Patch tested only on x86_64-pc-linux-gnu.
Make the error message more intelligible for the average user.
Thank you very much.
Best regards,
José Rui
2020-8-21 José Rui Faustino de Sousa
gcc/fortran/ChangeLog:
PR fortran/96870
* misc.c (gfc_typename): use class name instead of internal name
on error message.
gcc/testsuite/ChangeLog:
PR fortran/96870
* gfortran.dg/PR96870.f90: New test.
diff --git a/gcc/fortran/misc.c b/gcc/fortran/misc.c
index 65bcfa6..43edfd8 100644
--- a/gcc/fortran/misc.c
+++ b/gcc/fortran/misc.c
@@ -184,8 +184,11 @@ gfc_typename (gfc_typespec *ts, bool for_hash)
break;
}
ts1 = ts->u.derived->components ? &ts->u.derived->components->ts : NULL;
- if (ts1 && ts1->u.derived && ts1->u.derived->attr.unlimited_polymorphic)
- sprintf (buffer, "CLASS(*)");
+ if (ts1 && ts1->u.derived)
+ if (ts1->u.derived->attr.unlimited_polymorphic)
+ sprintf (buffer, "CLASS(*)");
+ else
+ sprintf (buffer, "CLASS(%s)", ts1->u.derived->name);
else
sprintf (buffer, "CLASS(%s)", ts->u.derived->name);
break;
diff --git a/gcc/testsuite/gfortran.dg/PR96870.f90 b/gcc/testsuite/gfortran.dg/PR96870.f90
new file mode 100644
index 000..c1b321e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR96870.f90
@@ -0,0 +1,41 @@
+! { dg-do compile }
+!
+! Test fix for PR96870
+!
+
+Program main_p
+
+ implicit none
+
+ Type :: t0
+ End Type t0
+
+ Type, extends(t0) :: t1
+ End Type t1
+
+ type(t0), target :: x
+ class(t0), pointer :: p
+
+ p => x
+ Call sub_1(x) ! { dg-error "Type mismatch in argument .p. at .1.; passed TYPE\\(t0\\) to CLASS\\(t1\\)" }
+ Call sub_1(p) ! { dg-error "Type mismatch in argument .p. at .1.; passed CLASS\\(t0\\) to CLASS\\(t1\\)" }
+ Call sub_2(x) ! { dg-error "Type mismatch in argument .p. at .1.; passed TYPE\\(t0\\) to TYPE\\(t1\\)" }
+ Call sub_2(p) ! { dg-error "Type mismatch in argument .p. at .1.; passed CLASS\\(t0\\) to TYPE\\(t1\\)" }
+ stop
+
+Contains
+
+ Subroutine sub_1(p)
+class(t1), Intent(In) :: p
+
+return
+ End Subroutine sub_1
+
+ Subroutine sub_2(p)
+type(t1), Intent(In) :: p
+
+return
+ End Subroutine sub_2
+
+End Program main_p
+
[Patch, fortran V2] PR fortran/100097 PR fortran/100098 - [Unlimited] polymorphic pointers and allocatables have incorrect rank
Hi All!
Proposed patch to:
PR100097 - Unlimited polymorphic pointers and allocatables have
incorrect rank
PR100098 - Polymorphic pointers and allocatables have incorrect rank
Patch tested only on x86_64-pc-linux-gnu.
Version 2 no longer re-initializes explicit initialized variables, which
are taken care of elsewhere.
Pointers, and allocatables, must carry TKR information even when
undefined. The patch adds code to initialize, for both pointers and
allocatables, the class descriptor element size, rank and type as soon
as possible to do so.
Thank you very much.
Best regards,
José Rui
Fortran: Add missing TKR initialization to class variables [PR100097,
PR100098]
gcc/fortran/ChangeLog:
PR fortran/100097
PR fortran/100098
* trans-array.c (gfc_trans_class_array): new function to
initialize class descriptor's TKR information.
* trans-array.h (gfc_trans_class_array): add function prototype.
* trans-decl.c (gfc_trans_deferred_vars): add calls to the new
function for both pointers and allocatables.
gcc/testsuite/ChangeLog:
PR fortran/100097
* gfortran.dg/PR100097.f90: New test.
PR fortran/100098
* gfortran.dg/PR100098.f90: New test.
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index a6bcd2b..feec734 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -10786,6 +10786,57 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
}
+/* Initialize class descriptor's TKR infomation. */
+
+void
+gfc_trans_class_array (gfc_symbol * sym, gfc_wrapped_block * block)
+{
+ tree type, etype;
+ tree tmp;
+ tree descriptor;
+ stmtblock_t init;
+ locus loc;
+ int rank;
+
+ /* Make sure the frontend gets these right. */
+ gcc_assert (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
+ && (CLASS_DATA (sym)->attr.class_pointer
+ || CLASS_DATA (sym)->attr.allocatable));
+
+ gcc_assert (VAR_P (sym->backend_decl)
+ || TREE_CODE (sym->backend_decl) == PARM_DECL);
+
+ if (sym->attr.dummy)
+return;
+
+ descriptor = gfc_class_data_get (sym->backend_decl);
+
+ /* Explicit initialization is done elsewhere. */
+ if (sym->attr.save || TREE_STATIC (descriptor))
+return;
+
+ type = TREE_TYPE (descriptor);
+
+ if (type == NULL || !GFC_DESCRIPTOR_TYPE_P (type))
+return;
+
+ gfc_save_backend_locus (&loc);
+ gfc_set_backend_locus (&sym->declared_at);
+ gfc_init_block (&init);
+
+ rank = CLASS_DATA (sym)->as ? (CLASS_DATA (sym)->as->rank) : (0);
+ gcc_assert (rank>=0);
+ tmp = gfc_conv_descriptor_dtype (descriptor);
+ etype = gfc_get_element_type (type);
+ tmp = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (tmp), tmp,
+ gfc_get_dtype_rank_type (rank, etype));
+ gfc_add_expr_to_block (&init, tmp);
+
+ gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
+ gfc_restore_backend_locus (&loc);
+}
+
+
/* NULLIFY an allocatable/pointer array on function entry, free it on exit.
Do likewise, recursively if necessary, with the allocatable components of
derived types. This function is also called for assumed-rank arrays, which
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index e4d443d..d2768f1 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -67,6 +67,8 @@ tree gfc_check_pdt_dummy (gfc_symbol *, tree, int, gfc_actual_arglist *);
tree gfc_alloc_allocatable_for_assignment (gfc_loopinfo*, gfc_expr*, gfc_expr*);
+/* Add initialization for class descriptors */
+void gfc_trans_class_array (gfc_symbol *, gfc_wrapped_block *);
/* Add initialization for deferred arrays. */
void gfc_trans_deferred_array (gfc_symbol *, gfc_wrapped_block *);
/* Generate an initializer for a static pointer or allocatable array. */
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 479ba6f..659e973 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -4943,7 +4943,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
else if ((!sym->attr.dummy || sym->ts.deferred)
&& (sym->ts.type == BT_CLASS
&& CLASS_DATA (sym)->attr.class_pointer))
- continue;
+ gfc_trans_class_array (sym, block);
else if ((!sym->attr.dummy || sym->ts.deferred)
&& (sym->attr.allocatable
|| (sym->attr.pointer && sym->attr.result)
@@ -5027,6 +5027,10 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
tmp = NULL_TREE;
}
+ /* Initialize descriptor's TKR information. */
+ if (sym->ts.type == BT_CLASS)
+ gfc_trans_class_array (sym, block);
+
/* Deallocate when leaving the scope. Nullifying is not
needed. */
if (!sym->attr.result && !sym->attr.dummy && !sym->attr.pointer
diff --git a/gcc/testsuite/gfortran.dg/PR100097.f90 b/gcc/testsuite/gfortran.dg/PR100097.f90
new file mode 100644
index 000..926eb6c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100097.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+!
+! Te
