from:"José Rui Faustino de Sousa via Gcc\-patches"

Re: [Patch, fortran V2] PR fortran/93308/93963/94327/94331/97046 problems raised by descriptor handling

2021-06-21 Thread José Rui Faustino de Sousa via Gcc-patches


Hi Tobias,

On 21/06/21 16:46, Tobias Burnus wrote:

Well, as said: directly into the compiler where currently the call to
libgomp is.

>

I don't think I understand were you mean. You don't mean the includes in 
"f95-lang.c" do you?


Best regards,
José Rui

Re: [Patch, fortran V2] PR fortran/93308/93963/94327/94331/97046 problems raised by descriptor handling

2021-06-21 Thread José Rui Faustino de Sousa via Gcc-patches


On 21/06/21 13:46, Tobias Burnus wrote:

Hi José,

(in principle, I'd like to have the libgfortran function moved to the
compiler proper to avoid some issues, but that's admittedly a task
independent of your work.)



cfi_desc_to_gfc_desc and gfc_desc_to_cfi_desc from ISO_c_binding.c, right?

Since fixing:

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=100917

https://gcc.gnu.org/bugzilla/show_bug.cgi?id=100910

would very likely require passing an additional "kind" parameter (and 
future descriptor unification) that would be a good idea.


I had a patch to do this, passing the kind value, but AFAIR there were 
issues with kind values for C_PTR and C_FUNPTR (and I didn't want to 
mess with the ABI also in one go)... But I might have fixed that 
somewhere else afterwards...


So, I could look further into that. Were would you like them placed?

LGTM – except for one minor nit. In trans-expr.c's 
gfc_conv_gfc_desc_to_cfi_desc:


    /* Transfer values back to gfc descriptor.  */
+  if (cfi_attribute != 2
+  && !fsym->attr.value
+  && fsym->attr.intent != INTENT_IN)

Can you add after the '2' the string '  /* CFI_attribute_other.  */'
to make the number less magic.



Yes... I had the same idea... :-) But all those constants are defined in 
"ISO_Fortran_binding.h"... And moving all those definitions would be a 
major change... So I left it as it was...


What do you suggest I do?

Best regards,
José Rui

Re: [Patch, fortran V3] PR fortran/100683 - Array initialization refuses valid

2021-06-21 Thread José Rui Faustino de Sousa via Gcc-patches


Hi Tobias,

On 21/06/21 12:37, Tobias Burnus wrote:

Thus: Do you have a list of patches pending review?

>

https://gcc.gnu.org/pipermail/fortran/2021-April/055924.html

https://gcc.gnu.org/pipermail/fortran/2021-April/055933.html

https://gcc.gnu.org/pipermail/fortran/2021-June/056168.html

https://gcc.gnu.org/pipermail/fortran/2021-June/056167.html

https://gcc.gnu.org/pipermail/fortran/2021-June/056163.html

https://gcc.gnu.org/pipermail/fortran/2021-June/056162.html

https://gcc.gnu.org/pipermail/fortran/2021-June/056155.html

https://gcc.gnu.org/pipermail/fortran/2021-June/056154.html

https://gcc.gnu.org/pipermail/fortran/2021-June/056152.html

https://gcc.gnu.org/pipermail/fortran/2021-June/056159.html

https://gcc.gnu.org/pipermail/fortran/2021-April/055982.html

https://gcc.gnu.org/pipermail/fortran/2021-April/055949.html

https://gcc.gnu.org/pipermail/fortran/2021-April/055946.html

https://gcc.gnu.org/pipermail/fortran/2021-April/055934.html

https://gcc.gnu.org/pipermail/fortran/2021-June/056169.html

https://gcc.gnu.org/pipermail/fortran/2021-April/055921.html

I am not 100% sure this is all of them but it should be most.


Secondly, I assume
you can commit or do you have commit issues?



Up to now there were no problems.

Best regards,
José Rui

[Patch, fortran V3] PR fortran/100683 - Array initialization refuses valid

2021-06-17 Thread José Rui Faustino de Sousa via Gcc-patches


Hi all!

Update to a proposed patch to:

PR100683 - Array initialization refuses valid

due to more errors being found...

Patch tested only on x86_64-pc-linux-gnu.

Add call to simplify expression before parsing *and* check 
*appropriately* if the expression is still an array after simplification.


Add two more situations (already present in the original PR) to 
pr87993.f90 to catch the kind of error I was making.


Thank you very much.

Best regards,
José Rui

Fortran: Fix bogus error

gcc/fortran/ChangeLog:

PR fortran/100683
* resolve.c (gfc_resolve_expr): Add call to gfc_simplify_expr.

gcc/testsuite/ChangeLog:

PR fortran/100683
* gfortran.dg/pr87993.f90: increased test coverage.
* gfortran.dg/PR100683.f90: New test.
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 45c3ad3..01a2977 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7137,7 +7137,12 @@ gfc_resolve_expr (gfc_expr *e)
   /* Also try to expand a constructor.  */
   if (t)
 	{
+	  t = gfc_simplify_expr (e, 1);
+	  if (!t)
+	break;
 	  gfc_expression_rank (e);
+	  if (e->expr_type != EXPR_ARRAY)
+	break;
 	  if (gfc_is_constant_expr (e) || gfc_is_expandable_expr (e))
 	gfc_expand_constructor (e, false);
 	}
diff --git a/gcc/testsuite/gfortran.dg/PR100683.f90 b/gcc/testsuite/gfortran.dg/PR100683.f90
new file mode 100644
index 000..6929bb5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100683.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+!
+! Test the fix for PR100683
+! 
+
+program main_p
+
+  implicit none
+
+  integer:: i
+  integer, parameter :: n = 11
+  integer, parameter :: u(*) = [(i, i=1,n)]
+
+  type :: foo_t
+integer :: i
+  end type foo_t
+
+  type, extends(foo_t) :: bar_t
+integer :: a(n)
+  end type bar_t
+  
+  type(bar_t), parameter :: a(*) = [(bar_t(i, u), i=1,n)]
+  type(bar_t):: b(n) = [(bar_t(i, u), i=1,n)]
+
+  if(any(a(:)%i/=u))   stop 1
+  do i = 1, n
+if(any(a(i)%a/=u)) stop 2
+  end do
+  if(any(b(:)%i/=u))   stop 3
+  do i = 1, n
+if(any(b(i)%a/=u)) stop 4
+  end do
+  stop
+
+end program main_p
+
diff --git a/gcc/testsuite/gfortran.dg/pr87993.f90 b/gcc/testsuite/gfortran.dg/pr87993.f90
index 96d353d..abc6d0d 100644
--- a/gcc/testsuite/gfortran.dg/pr87993.f90
+++ b/gcc/testsuite/gfortran.dg/pr87993.f90
@@ -2,7 +2,15 @@
 ! Code contributed by Gerhard Steinmetz 
 program p
integer, parameter :: a(2) = 1
-   integer, parameter :: b = a%kind
+   character, parameter :: b(2) = "X"
+   integer, parameter :: i = a%kind
+   integer, parameter :: j = a(2)%kind
+   integer, parameter :: k = b%kind
+   integer, parameter :: l = b(2)%kind
if (any(a /= 1)) stop 1
-   if (b /= kind(a)) stop 2
+   if (any(b /= "X")) stop 2
+   if (i /= kind(a)) stop 3
+   if (j /= kind(a)) stop 4
+   if (k /= kind(b)) stop 5
+   if (l /= kind(b)) stop 6
 end

[Patch, fortran V2] PR fortran/100097 PR fortran/100098 - [Unlimited] polymorphic pointers and allocatables have incorrect rank

2021-06-16 Thread José Rui Faustino de Sousa via Gcc-patches


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 ();
+  gfc_set_backend_locus (>declared_at);
+  gfc_init_block ();
+
+  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 (, tmp);
+
+  gfc_add_init_cleanup (block, gfc_finish_block (), NULL_TREE);
+  gfc_restore_backend_locus ();
+}
+
+
 /* 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 }
+!
+! Test the fix for PR100097
+!

PING: [Patch, fortran] PR fortran/96870 - Class name on error message

2021-06-16 Thread José Rui Faustino de Sousa via Gcc-patches


*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: fort...@gcc.gnu.org, gcc-patches@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 ? >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
+

PING: [Patch, fortran] PR fortran/96724 - Bogus warnings with the repeat intrinsic and the flag -Wconversion-extra

2021-06-16 Thread José Rui Faustino de Sousa via Gcc-patches


*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: fort...@gcc.gnu.org, gcc-patches@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, , 2, 0);
+	}
+  if (tmp->ts.kind != gfc_index_integer_kind)
+	gfc_convert_type_warn (tmp, >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

[Patch, fortran V2] PR fortran/93308/93963/94327/94331/97046 problems raised by descriptor handling

2021-06-14 Thread José Rui Faustino de Sousa via Gcc-patches


Hi all!

Update to a proposed patch to:

Bug 93308 - bind(c) subroutine changes lower bound of array argument in 
caller
Bug 93963 - Select rank mishandling allocatable and pointer arguments 
with bind(c)

Bug 94327 - Bind(c) argument attributes are incorrectly set
Bug 94331 - Bind(C) corrupts array descriptors
Bug 97046 - Bad interaction between lbound/ubound, allocatable arrays 
and bind(C) subroutine with dimension(..) parameter


due to errors found in one of the tests by Dominique d'Humieres.

Patch tested only on x86_64-pc-linux-gnu.

Fix attribute handling, which reflect a prior intermediate version of 
the Fortran standard.


CFI descriptors, in most cases, should not be copied out has they can 
corrupt the Fortran descriptor. Bounds will vary and the original 
Fortran bounds are definitively lost on conversion.


Thank you very much.

Best regards,
José Rui

Fortran: Fix attributtes and bounds in ISO_Fortran_binding.

gcc/fortran/ChangeLog:

PR fortran/93308
PR fortran/93963
PR fortran/94327
PR fortran/94331
PR fortran/97046
* trans-decl.c (convert_CFI_desc): Only copy out the descriptor
if necessary.
* trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Updated attribute
handling which reflect a previous intermediate version of the
standard. Only copy out the descriptor if necessary.

libgfortran/ChangeLog:

PR fortran/93308
PR fortran/93963
PR fortran/94327
PR fortran/94331
PR fortran/97046
* runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Add code
to verify the descriptor. Correct bounds calculation.
(gfc_desc_to_cfi_desc): Add code to verify the descriptor.

gcc/testsuite/ChangeLog:

PR fortran/93308
PR fortran/93963
PR fortran/94327
PR fortran/94331
PR fortran/97046
* gfortran.dg/ISO_Fortran_binding_1.f90: Add pointer attribute,
this test is still erroneous but now it compiles.
* gfortran.dg/bind_c_array_params_2.f90: Update regex to match
code changes.
* gfortran.dg/PR93308.f90: New test.
* gfortran.dg/PR93963.f90: New test.
* gfortran.dg/PR94327.c: New test.
* gfortran.dg/PR94327.f90: New test.
* gfortran.dg/PR94331.c: New test.
* gfortran.dg/PR94331.f90: New test.
* gfortran.dg/PR97046.f90: New test.
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index c32bd05..97aafe3 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -4526,22 +4526,28 @@ convert_CFI_desc (gfc_wrapped_block * block, gfc_symbol *sym)
   gfc_add_expr_to_block (_block, incoming);
   incoming = gfc_finish_block (_block);
 
-
   /* Convert the gfc descriptor back to the CFI type before going
 	 out of scope, if the CFI type was present at entry.  */
-  gfc_init_block (_block);
-  gfc_init_block ();
-
-  tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr);
-  outgoing = build_call_expr_loc (input_location,
-			gfor_fndecl_gfc_to_cfi, 2, tmp, gfc_desc_ptr);
-  gfc_add_expr_to_block (, outgoing);
+  outgoing = NULL_TREE;
+  if ((sym->attr.pointer || sym->attr.allocatable)
+	  && !sym->attr.value
+	  && sym->attr.intent != INTENT_IN)
+	{
+	  gfc_init_block (_block);
+	  gfc_init_block ();
 
-  outgoing = build3_v (COND_EXPR, present,
-			   gfc_finish_block (),
-			   build_empty_stmt (input_location));
-  gfc_add_expr_to_block (_block, outgoing);
-  outgoing = gfc_finish_block (_block);
+	  tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr);
+	  outgoing = build_call_expr_loc (input_location,
+	  gfor_fndecl_gfc_to_cfi, 2,
+	  tmp, gfc_desc_ptr);
+	  gfc_add_expr_to_block (, outgoing);
+
+	  outgoing = build3_v (COND_EXPR, present,
+			   gfc_finish_block (),
+			   build_empty_stmt (input_location));
+	  gfc_add_expr_to_block (_block, outgoing);
+	  outgoing = gfc_finish_block (_block);
+	}
 
   /* Add the lot to the procedure init and finally blocks.  */
   gfc_add_init_cleanup (block, incoming, outgoing);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index de406ad..52e243b 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5501,13 +5501,12 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
 	attribute = 1;
 }
 
-  /* If the formal argument is assumed shape and neither a pointer nor
- allocatable, it is unconditionally CFI_attribute_other.  */
-  if (fsym->as->type == AS_ASSUMED_SHAPE
-  && !fsym->attr.pointer && !fsym->attr.allocatable)
-   cfi_attribute = 2;
+  if (fsym->attr.pointer)
+cfi_attribute = 0;
+  else if (fsym->attr.allocatable)
+cfi_attribute = 1;
   else
-   cfi_attribute = attribute;
+cfi_attribute = 2;
 
   if (e->rank != 0)
 {
@@ -5615,10 +5614,15 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
   gfc_prepend_expr_to_block (>post, tmp);
 
   /* Transfer values back to gfc descriptor.  */
-  tmp = gfc_build_addr_expr

[Patch, fortran] PR fortran/94104 - Request for diagnostic improvement

2021-06-14 Thread José Rui Faustino de Sousa via Gcc-patches


Hi all!

Proposed patch to:

Bug 94104 - Request for diagnostic improvement

Patch tested only on x86_64-pc-linux-gnu.

Error message improvement. In Fortran 2008 actual arguments to 
procedures having a pointer, with intent attribute in, formal argument 
can also have the target attribute not just pointer.


Thank you very much.

Best regards,
José Rui

Fortran: error message improvement.

PR fortran/94104

gcc/fortran/ChangeLog:

* interface.c (gfc_compare_actual_formal): improve error message.

gcc/testsuite/ChangeLog:

* gfortran.dg/parens_2.f90: update regex.
* gfortran.dg/PR94104a.f90: New test.
* gfortran.dg/PR94104b.f90: New test.

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 9e3e8aa..4cc0708 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -3329,26 +3329,38 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	  return false;
 	}
 
-  if (a->expr->expr_type != EXPR_NULL
-	  && compare_pointer (f->sym, a->expr) == 0)
+  if (a->expr->expr_type != EXPR_NULL)
 	{
-	  if (where)
-	gfc_error ("Actual argument for %qs must be a pointer at %L",
-		   f->sym->name, >expr->where);
-	  return false;
-	}
+	  int cmp = compare_pointer (f->sym, a->expr);
+	  bool pre2008 = ((gfc_option.allow_std & GFC_STD_F2008) == 0);
+	  
+	  if (pre2008 && cmp == 0)
+	{
+	  if (where)
+		gfc_error ("Actual argument for %qs at %L must be a pointer.",
+			   f->sym->name, >expr->where);
+	  return false;
+	}
+	  
+	  if (pre2008 && cmp == 2)
+	{
+	  if (where)
+		gfc_error ("Fortran 2008: Non-pointer actual argument at %L to "
+			   "pointer dummy %qs", >expr->where,f->sym->name);
+	  return false;
+	}
 
-  if (a->expr->expr_type != EXPR_NULL
-	  && (gfc_option.allow_std & GFC_STD_F2008) == 0
-	  && compare_pointer (f->sym, a->expr) == 2)
-	{
-	  if (where)
-	gfc_error ("Fortran 2008: Non-pointer actual argument at %L to "
-		   "pointer dummy %qs", >expr->where,f->sym->name);
-	  return false;
+	  if (!pre2008 && cmp == 0)
+	{
+	  if (where)
+		gfc_error ("Actual argument for %qs at %L must be a pointer "
+			   "or a valid target for the dummy pointer in a "
+			   "pointer assignment statement.",
+			   f->sym->name, >expr->where);
+	  return false;
+	}
 	}
 
-
   /* Fortran 2008, C1242.  */
   if (f->sym->attr.pointer && gfc_is_coindexed (a->expr))
 	{
diff --git a/gcc/testsuite/gfortran.dg/PR94104a.f90 b/gcc/testsuite/gfortran.dg/PR94104a.f90
new file mode 100644
index 000..acde7fe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR94104a.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+! { dg-shouldfail "Actual argument" }
+!
+! PR fortran/94104
+!
+
+program diag_p
+
+  implicit none
+
+  integer, parameter :: n = 7
+
+  integer :: a(n)
+  integer, target :: b(n)
+
+  a = 1
+  print *, sumf(a) ! { dg-error "Actual argument for 'a' at .1. must be a pointer\\." }
+  print *, sumf(b) ! { dg-error "Fortran 2008: Non-pointer actual argument at .1. to pointer dummy 'a'" }
+  stop
+
+contains
+
+  function sumf(a) result(s)
+integer, pointer, intent(in) :: a(:)
+
+integer :: s
+
+s = sum(a)
+return
+  end function sumf
+
+end program diag_p
+
+
diff --git a/gcc/testsuite/gfortran.dg/PR94104b.f90 b/gcc/testsuite/gfortran.dg/PR94104b.f90
new file mode 100644
index 000..5018da9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR94104b.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+! { dg-shouldfail "Actual argument" }
+!
+! PR fortran/94104
+!
+
+program diag_p
+
+  implicit none
+
+  integer, parameter :: n = 7
+
+  integer :: a(n)
+  integer, target :: b(n)
+
+  a = 1
+  print *, sumf(a) ! { dg-error "Actual argument for 'a' at .1. must be a pointer or a valid target" }
+  print *, sumf(b)
+  stop
+
+contains
+
+  function sumf(a) result(s)
+integer, pointer, intent(in) :: a(:)
+
+integer :: s
+
+s = sum(a)
+return
+  end function sumf
+
+end program diag_p
+
+
diff --git a/gcc/testsuite/gfortran.dg/parens_2.f90 b/gcc/testsuite/gfortran.dg/parens_2.f90
index bc2acd8..dc5965d 100644
--- a/gcc/testsuite/gfortran.dg/parens_2.f90
+++ b/gcc/testsuite/gfortran.dg/parens_2.f90
@@ -2,7 +2,7 @@
 ! { dg-do compile }
 ! Originally contributed by Joost VandeVondele
 INTEGER, POINTER :: I
-CALL S1((I)) ! { dg-error "Actual argument for .i. must be a pointer" }
+CALL S1((I)) ! { dg-error "Actual argument for .i. at .1. must be a pointer or a valid target" }
 CONTAINS
  SUBROUTINE S1(I)
   INTEGER, POINTER ::I

[Patch, fortran V2] PR fortran/100683 - Array initialization refuses valid

2021-06-14 Thread José Rui Faustino de Sousa via Gcc-patches


Hi all!

Update to a proposed patch to:

PR100683 - Array initialization refuses valid

due to errors found by Dominique d'Humieres.

Patch tested only on x86_64-pc-linux-gnu.

Add call to simplify expression before parsing *and* check if the 
expression is still an array after simplification.


Thank you very much.

Best regards,
José Rui

Fortran: Fix bogus error

gcc/fortran/ChangeLog:

PR fortran/100683
* resolve.c (gfc_resolve_expr): Add call to gfc_simplify_expr.

gcc/testsuite/ChangeLog:

PR fortran/100683
* gfortran.dg/PR100683.f90: New test.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index a37ad66..a9518e7 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7138,8 +7138,10 @@ gfc_resolve_expr (gfc_expr *e)
   /* Also try to expand a constructor.  */
   if (t)
 	{
+	  gfc_simplify_expr(e, 1);
 	  gfc_expression_rank (e);
-	  if (gfc_is_constant_expr (e) || gfc_is_expandable_expr (e))
+	  if (e->expr_type == EXPR_ARRAY
+	  && (gfc_is_constant_expr (e) || gfc_is_expandable_expr (e)))
 	gfc_expand_constructor (e, false);
 	}
 
diff --git a/gcc/testsuite/gfortran.dg/PR100683.f90 b/gcc/testsuite/gfortran.dg/PR100683.f90
new file mode 100644
index 000..6929bb5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100683.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+!
+! Test the fix for PR100683
+! 
+
+program main_p
+
+  implicit none
+
+  integer:: i
+  integer, parameter :: n = 11
+  integer, parameter :: u(*) = [(i, i=1,n)]
+
+  type :: foo_t
+integer :: i
+  end type foo_t
+
+  type, extends(foo_t) :: bar_t
+integer :: a(n)
+  end type bar_t
+  
+  type(bar_t), parameter :: a(*) = [(bar_t(i, u), i=1,n)]
+  type(bar_t):: b(n) = [(bar_t(i, u), i=1,n)]
+
+  if(any(a(:)%i/=u))   stop 1
+  do i = 1, n
+if(any(a(i)%a/=u)) stop 2
+  end do
+  if(any(b(:)%i/=u))   stop 3
+  do i = 1, n
+if(any(b(i)%a/=u)) stop 4
+  end do
+  stop
+
+end program main_p
+

PING: [Patch, fortran v2] PR fortran/92621 Problems with memory handling with allocatable intent(out) arrays with bind(c)

2021-06-14 Thread José Rui Faustino de Sousa via Gcc-patches

*PING*

 Forwarded Message 
Subject: [Patch, fortran v2] PR fortran/92621 Problems with memory 
handling with allocatable intent(out) arrays with bind(c)

Date: Mon, 26 Apr 2021 11:21:25 +
From: José Rui Faustino de Sousa 
To: fort...@gcc.gnu.org, gcc-patches@gcc.gnu.org

Hi all!

Proposed patch to:

PR92621 - Problems with memory handling with allocatable intent(out) 
arrays with bind(c)

Patch tested only on x86_64-pc-linux-gnu.

The code currently generated tries to deallocate the undefined 
artificial cfi.n pointer before it is associated with the allocatable array.

Since the cfi.n pointer is undefined attempting to free it is really a 
bad idea and it will frequently segfault.

Consequently, since the deallocation is done before the cfi.n pointer is 
associated with anything, the allocatable array is never freed, like it 
should, and it will be passed still allocated causing subsequent 
attempts to allocate it to fail.

Version 2 is basically a ping, fixes a typo, replaces an if block with a 
flag to make reviewing easier and replaces a call to malloc with calloc 
to make Valgrind happy.

Thank you very much.

Best regards,
José Rui

Fortran: Fix segfaults due to freeing undefined pointer [PR92621]

gcc/fortran/ChangeLog:

PR fortran/92621
* trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Add code to
deallocate allocatable intent(out) dummy array arguments and
slightly rearrange code.
(gfc_conv_procedure_call): Add a flag to avoid double frees,
removes unnecessary checks for bind(c) objects and obsolete
comments.

libgfortran/ChangeLog:

PR fortran/92621
* runtime/ISO_Fortran_binding.c (gfc_desc_to_cfi_desc): replaces
a call to malloc with calloc to make Valgrind happy.

gcc/testsuite/ChangeLog:

PR fortran/92621
* gfortran.dg/bind-c-intent-out.f90: Changes regex to match the
changes in code generation.
* gfortran.dg/PR92621.f90: Improved new test.

[Patch, fortran] PR fortran/100948 - [12 Regression] ICE in gfc_conv_expr_val, at fortran/trans-expr.c:9069

2021-06-13 Thread José Rui Faustino de Sousa via Gcc-patches


Hi all!

Proposed partial patch to:

Bug 100948 - [12 Regression] ICE in gfc_conv_expr_val, at 
fortran/trans-expr.c:9069


Patch tested only on x86_64-pc-linux-gnu.

Reuse previously calculated full string length to set string section 
default upper bound.


This patch only fixes the ICE the code produced is still wrong.

Thank you very much.

Best regards,
José Rui

Fortran: Fix ICE.

gcc/fortran/ChangeLog:

PR fortran/100948
* trans-expr.c (gfc_get_expr_charlen): reuse previously calculated
full string length to set string section default upper bound.

gcc/testsuite/ChangeLog:

PR fortran/100948
* gfortran.dg/PR100948.f90: New test.

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index de406ad..1970cfc 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2152,17 +2152,25 @@ gfc_get_expr_charlen (gfc_expr *e)
 	  break;
 
 	case REF_SUBSTRING:
-	  gfc_init_se (, NULL);
-	  gfc_conv_expr_type (, r->u.ss.start, gfc_charlen_type_node);
-	  length = se.expr;
-	  gfc_conv_expr_type (, r->u.ss.end, gfc_charlen_type_node);
-	  length = fold_build2_loc (input_location, MINUS_EXPR,
-gfc_charlen_type_node,
-se.expr, length);
-	  length = fold_build2_loc (input_location, PLUS_EXPR,
-gfc_charlen_type_node, length,
-gfc_index_one_node);
-	  break;
+	  {
+	tree start;
+	
+	gfc_init_se (, NULL);
+	gcc_assert (r->u.ss.start);
+	gfc_conv_expr_type (, r->u.ss.start, gfc_charlen_type_node);
+	start = se.expr;
+	if (r->u.ss.end)
+	  gfc_conv_expr_type (, r->u.ss.end, gfc_charlen_type_node);
+	else
+	  se.expr = length;
+	length = fold_build2_loc (input_location, MINUS_EXPR,
+  gfc_charlen_type_node,
+  se.expr, start);
+	length = fold_build2_loc (input_location, PLUS_EXPR,
+  gfc_charlen_type_node, length,
+  gfc_index_one_node);
+	break;
+	  }
 
 	default:
 	  gcc_unreachable ();
diff --git a/gcc/testsuite/gfortran.dg/PR100948.f90 b/gcc/testsuite/gfortran.dg/PR100948.f90
new file mode 100644
index 000..c0e333f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100948.f90
@@ -0,0 +1,218 @@
+! { dg-do run }
+!
+! Tests fix for PR100948
+!
+! Based on contribution by JG. Steinmetz 
+!
+
+program dct_p
+
+  implicit none
+
+  integer, parameter :: n = 2
+  integer, parameter :: m = 3
+
+  character(len=*), parameter :: u(*) = ["abc", "uvw"]
+
+  type :: dca_t
+character(:), allocatable :: c(:)
+  end type dca_t
+
+  type :: dcp_t
+character(:), pointer :: c(:)
+  end type dcp_t
+
+  character(len=m), target :: a(n)
+
+  a = u
+  if (size(a)/=n)stop 1
+  if (len(a)/=m) stop 2
+  if (any(a/=u)) stop 3
+  call dcs0(a)
+  if (size(a)/=n)stop 4
+  if (len(a)/=m) stop 5
+  if (any(a/=u)) stop 6
+  a = u
+  call dcs1(a)
+  if (size(a)/=n)stop 7
+  if (len(a)/=m) stop 8
+  if (any(a/=u)) stop 9
+  a = u
+  call dcs2(a)
+  if (size(a)/=n)stop 10
+  if (len(a)/=m) stop 11
+  if (any(a/=u)) stop 12
+  a = u
+  call dcs3(a)
+  if (size(a)/=n)stop 13
+  if (len(a)/=m) stop 14
+  if (any(a/=u)) stop 15
+  a = u
+  call dcs4(a)
+  if (size(a)/=n)stop 16
+  if (len(a)/=m) stop 17
+  if (any(a/=u)) stop 18
+  a = u
+  call dcs5(a)
+  if (size(a)/=n)stop 19
+  if (len(a)/=m) stop 20
+  if (any(a/=u)) stop 21
+  a = u
+  call dcs6(a)
+  if (size(a)/=n)stop 22
+  if (len(a)/=m) stop 23
+  if (any(a/=u)) stop 24
+  a = u
+  call dcs7(a)
+  if (size(a)/=n)stop 25
+  if (len(a)/=m) stop 26
+  if (any(a/=u)) stop 27
+  stop
+
+contains
+
+  subroutine dcs0(a)
+character(len=*), intent(in) :: a(:)
+
+if (size(a)/=n)  stop 28
+if (len(a)/=m)   stop 29
+if (any(a/=u))   stop 30
+associate (q => a(:)(:))
+  if (size(q)/=n)stop 31
+  if (len(q)/=m) stop 32
+  if (any(q/=u)) stop 33
+end associate
+return
+  end subroutine dcs0
+
+  subroutine dcs1(a)
+character(len=*), intent(in) :: a(:)
+
+character(len=len(a)) :: b(size(a))
+
+b = a(:)(:)
+if (size(b)/=n)  stop 34
+if (len(b)/=m)   stop 35
+if (any(b/=u))   stop 36
+associate (q => b(:)(:))
+  if (size(q)/=n)stop 37
+  if (len(q)/=m) stop 38
+  if (any(q/=u)) stop 39
+end associate
+return
+  end subroutine dcs1
+
+  subroutine dcs2(a)
+character(len=*), target, intent(in) :: a(:)
+
+character(:), pointer :: p(:)
+
+p => a(:)(:)
+if

Re: [Patch, fortran] PR fortran/101047/101048 Pointer explicit initialization

2021-06-13 Thread José Rui Faustino de Sousa via Gcc-patches


On 13/06/21 15:46, José Rui Faustino de Sousa wrote:

Hi All!

Proposed patch to:



And again I forgot to add the patch...

Sorry for the inconvenience.

Best regards,
José Rui

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 93118ad..5670d18 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -443,7 +443,7 @@ gfc_is_class_container_ref (gfc_expr *e)
component to the corresponding type (or the declared type, given by ts).  */
 
 gfc_expr *
-gfc_class_initializer (gfc_typespec *ts, gfc_expr *init_expr)
+gfc_class_initializer (gfc_typespec *ts, gfc_expr *init_expr, bool pointer)
 {
   gfc_expr *init;
   gfc_component *comp;
@@ -464,7 +464,10 @@ gfc_class_initializer (gfc_typespec *ts, gfc_expr *init_expr)
   if (strcmp (comp->name, "_vptr") == 0 && vtab)
 	ctor->expr = gfc_lval_expr_from_sym (vtab);
   else if (init_expr && init_expr->expr_type != EXPR_NULL)
-	  ctor->expr = gfc_copy_expr (init_expr);
+	ctor->expr = gfc_copy_expr (init_expr);
+  else if (strcmp (comp->name, "_data") == 0 && pointer)
+	ctor->expr = (init_expr && init_expr->expr_type == EXPR_NULL)
+	  ? (gfc_get_null_expr (NULL)) : (NULL);
   else
 	ctor->expr = gfc_get_null_expr (NULL);
   gfc_constructor_append (>value.constructor, ctor);
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 956003e..32b2849 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4433,15 +4433,19 @@ bool
 gfc_check_assign_symbol (gfc_symbol *sym, gfc_component *comp, gfc_expr *rvalue)
 {
   gfc_expr lvalue;
+  gfc_array_spec *as;
   bool r;
-  bool pointer, proc_pointer;
+  bool is_class, pointer, proc_pointer;
 
   memset (, '\0', sizeof (gfc_expr));
 
+  is_class = (sym->ts.type == BT_CLASS) && CLASS_DATA (sym);
+  as = is_class ? (CLASS_DATA (sym)->as) : (sym->as);
+  
   lvalue.expr_type = EXPR_VARIABLE;
   lvalue.ts = sym->ts;
-  if (sym->as)
-lvalue.rank = sym->as->rank;
+  if (as)
+lvalue.rank = as->rank;
   lvalue.symtree = XCNEW (gfc_symtree);
   lvalue.symtree->n.sym = sym;
   lvalue.where = sym->declared_at;
@@ -4461,7 +4465,7 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_component *comp, gfc_expr *rvalue)
 }
   else
 {
-  pointer = sym->ts.type == BT_CLASS &&  CLASS_DATA (sym)
+  pointer = is_class
 		? CLASS_DATA (sym)->attr.class_pointer : sym->attr.pointer;
   proc_pointer = sym->attr.proc_pointer;
 }
@@ -4883,32 +4887,21 @@ get_union_initializer (gfc_symbol *union_type, gfc_component **map_p)
 }
 
 static bool
-class_allocatable (gfc_component *comp)
-{
-  return comp->ts.type == BT_CLASS && CLASS_DATA (comp)
-&& CLASS_DATA (comp)->attr.allocatable;
-}
-
-static bool
-class_pointer (gfc_component *comp)
-{
-  return comp->ts.type == BT_CLASS && CLASS_DATA (comp)
-&& CLASS_DATA (comp)->attr.pointer;
-}
-
-static bool
 comp_allocatable (gfc_component *comp)
 {
-  return comp->attr.allocatable || class_allocatable (comp);
+  if (comp->ts.type == BT_CLASS && CLASS_DATA (comp))
+return CLASS_DATA (comp)->attr.allocatable;
+  return comp->attr.allocatable;
 }
 
 static bool
 comp_pointer (gfc_component *comp)
 {
-  return comp->attr.pointer
-|| comp->attr.proc_pointer
-|| comp->attr.class_pointer
-|| class_pointer (comp);
+  if (comp->attr.proc_pointer)
+return true;
+  if (comp->ts.type == BT_CLASS && CLASS_DATA (comp))
+return CLASS_DATA (comp)->attr.class_pointer;
+  return comp->attr.pointer;
 }
 
 /* Fetch or generate an initializer for the given component.
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index cbc95d3..52a76bc 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3673,7 +3673,7 @@ void gfc_add_class_array_ref (gfc_expr *);
 bool gfc_is_class_array_ref (gfc_expr *, bool *);
 bool gfc_is_class_scalar_expr (gfc_expr *);
 bool gfc_is_class_container_ref (gfc_expr *e);
-gfc_expr *gfc_class_initializer (gfc_typespec *, gfc_expr *);
+gfc_expr *gfc_class_initializer (gfc_typespec *, gfc_expr *, bool);
 unsigned int gfc_hash_value (gfc_symbol *);
 gfc_expr *gfc_get_len_component (gfc_expr *e, int);
 bool gfc_build_class_symbol (gfc_typespec *, symbol_attribute *,
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index a6bcd2b..891f82a 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -406,20 +406,288 @@ gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree desc,
   gfc_add_modify (block, t, fold_convert (TREE_TYPE (t), value));
 }
 
+
+/* Create a new dtype constructor.  */
+
+static tree
+build_init_dtype (tree ctor, int rank)
+{
+  tree type;
+  tree field;
+  tree value;
+  tree init;
+  vec *vlst = NULL;
+
+  gcc_assert (TREE_CODE (ctor) == CONSTRUCTOR);
+  type = TREE_TYPE (ctor);
+
+  value = gfc_get_expr_from_ctor (ctor, 0);
+  if (value == NULL_TREE)
+value = integer_zero_node;
+  if (!TREE_CONSTANT (value) || TREE_SIDE_EFFECTS (value))
+value = (DECL_INITIAL (value))
+  ? (DECL_INITIAL (value)) : (integer_zero_node);
+

[Patch, fortran] PR fortran/101047/101048 Pointer explicit initialization

2021-06-13 Thread José Rui Faustino de Sousa via Gcc-patches


Hi All!

Proposed patch to:

Bug 101047 - Pointer explicit initialization fails
Bug 101048 - Class pointer explicit initialization refuses valid

Patch tested only on x86_64-pc-linux-gnu.

This patch deals with implementation of explicit initialization for 
pointer variables.


It basically relies on using "gfc_conv_expr_descriptor" to build a 
pointer assignment and re-parsing it back into a descriptor constructor.


It proceeds to implement the necessary differences between allocatable 
and pointer variables explicit initialization and to add, and correct, 
missing references to "CLASS_DATA" entities.


Thank you very much.

Best regards,
José Rui

Fortran: get pointer explicit initialization working.

gcc/fortran/ChangeLog:

PR fortran/10148
* class.c (gfc_class_initializer): only disassociate pointer if
explicitly requested.
PR fortran/10148
* expr.c (gfc_check_assign_symbol): get rank from CLASS_DATA if
necessary.
PR fortran/10147
* expr.c (class_allocatable): remove unnecessary auxiliary
function.
(class_pointer): remove unnecessary auxiliary function.
(comp_allocatable): consolidate allocatable attribute checking.
(comp_pointer): consolidate pointer attribute checking.
* gfortran.h (gfc_class_initializer): change prototype to reflect
the extra parameter.
* trans-array.c: new group of functions to re-parse a
"STATEMENT_LIST" back into a "CONSTRUCTOR".
(build_init_dtype): Create a new dtype constructor.
(build_init_desc_dtype): Find the old dtype constructor and create
a new one.
(append_init_dim): Append one of dim fields to vector.
(build_init_dim): Create a dim constructor.
(build_init_desc_dim): Create the dim array constructor.
(append_desc_field): Append a field to the constructor vector.
(build_init_descriptor): Create an array descriptor constructor.
(gfc_build_init_descriptor_dtype): new function to build a
descriptor containing only a dtype.
(gfc_build_null_descriptor): update function to nullify and add
the dtype.
(gfc_build_init_descriptor): new function to build a full array
descriptor constructor.
(gfc_trans_static_array_pointer): updated to take in consideration
the diferences between pointer and allocatable explicit
initialization and the initialization of entities containing
"CLASS_DATA".
(gfc_conv_array_initializer): change function calls to reflect
interface changes.
* trans-array.h (gfc_trans_static_array_pointer): add return
value.
(gfc_build_null_descriptor): add parameter to prototype.
(gfc_build_init_descriptor): new prototype.
* trans-common.c (create_common): change function call to reflect
interface changes.
* trans-decl.c (gfc_create_string_length): set initial deferred
character length to zero.
(gfc_get_symbol_decl): change function call to reflect interface
changes.
(get_proc_pointer_decl): change function call to reflect interface
changes.
(gfc_trans_deferred_vars): change function call to reflect
interface changes.
(gfc_emit_parameter_debug_info): get rank from CLASS_DATA if
necessary, change function call to reflect interface changes.
* trans-expr.c (gfc_class_unlimited_poly): new auxiliary function
to check if a tree representing a type is unlimited polymorphic.
(gfc_conv_initializer): renamed gfc_conv_initializer_common.
(gfc_conv_initializer_common): take in consideration differences
between pointers and allocatables in initialization.
(gfc_conv_sym_initializer): interface for initialization using
gfc_symbol.
(gfc_conv_comp_initializer): interface for initialization using
gfc_component.
(gfc_conv_expr_initializer): interface for initialization using
gfc_expr.
(gfc_trans_subcomponent_assign): change function call to reflect
interface changes.
(gfc_conv_union_initializer): change function call to reflect
interface changes.
(gfc_conv_structure): split in two divide between explicit
initialization default initialization.
(gfc_conv_structure_initializer): handles explicit initialization
of every component field.
(gfc_conv_expr): change function call to reflect interface
changes.
* trans-types.c (gfc_get_dtype_rank_type): if the "static_flag" is
set elem_len to the initial value, from "DECL_INITIAL", or zero.
* trans-types.h (gfc_get_dtype_rank_type): add parameter to
prototype.
* trans.c: new group of functions to extract a RHS from a
"CONSTRUCTOR" or a "STATEMENT_LIST" or a "MODIFY_EXPR".
(tree_ref_equal): simple tree equality check.

[Patch, fortran] PR fortran/100120/100816/100818/100819/100821 problems raised by aggregate data types

2021-05-28 Thread José Rui Faustino de Sousa via Gcc-patches


Hi all!

Proposed patch to:

Bug 100120 - associated intrinsic failure
Bug 100816 - Wrong span on widechar
Bug 100818 - A temporary is passed to associated
Bug 100819 - Wrong code generation with unlimited polymorphic objects 
and character type

Bug 100821 - Deferred character with wrong length

Patch tested only on x86_64-pc-linux-gnu.

This patch mostly deals with setting "span" and "elem_len" for aggregate 
types. For that it is necessary to work around the way in which deferred 
type is implemented, which works fine for assumed character length, but 
doesn't work properly with more dynamic lengths, like with deferred 
character. And to make sure that unlimited polymorphic objects have 
"_len" properly set and receive correct the dynamic type data.
After requiring that no temporaries are created to pass to "associated" 
one notices that the library "associated" implementation relies on 
"elem_len", which may vary for parent types or sub strings, and not on 
the full object size "span", also leading to associated objects not 
being recognized as such.
Finally efforts were made so that the "span" calculation is done on 
descriptor creation and referred to afterwards, only being recalculated 
as a last resort.


Thank you very much.

Best regards,
José Rui

Fortran: Fix some issues with pointers to character.

gcc/fortran/ChangeLog:

PR fortran/100120/100816/100818/100819/100821
* trans-array.c (gfc_get_array_span): rework the way character
array "span" was calculated.
(gfc_conv_expr_descriptor): improve handling of character
sections and unlimited polymorphic objects.
* trans-expr.c (gfc_get_character_len): new function to
calculate character string length.
(gfc_get_character_len_in_bytes): new function to calculate
character string length in bytes.
(gfc_conv_scalar_to_descriptor): add call to set the "span".
(gfc_trans_pointer_assignment): set "_len" and antecipate the
initialization of the deferred character length hidden argument.
* trans-intrinsic.c (gfc_conv_associated): set "force_no_tmp" to
avoid the creation of a temporary.
* trans-types.c (gfc_get_dtype_rank_type): rework type detection
so that unlimited polymorphic objects get proper type
infomation, also important for bind(c).
(gfc_get_dtype): add argument to pass the rank if necessary.
(gfc_get_array_type_bounds): cosmetic change to have character
arrays called character instead of unknown.
* trans-types.h (gfc_get_dtype): modify prototype.
* trans.c (get_array_span): rework the way character array
"span" was calculated.
* trans.h (gfc_get_character_len): new prototype.
(gfc_get_character_len_in_bytes): new prototype.
Add "unlimited_polymorphic" flag to "gfc_se" type to signal when
expression carries an unlimited polymorphic object.

libgfortran/ChangeLog:

PR fortran/100120
* intrinsics/associated.c (associated): have associated verify
if the "span" matches insted of the "elem_len".
* libgfortran.h (GFC_DESCRIPTOR_SPAN): add macro to retrive the
descriptor "span".

gcc/testsuite/ChangeLog:

PR fortran/100120
* gfortran.dg/PR100120.f90: New test.
PR fortran/100816
PR fortran/100818
PR fortran/100819
PR fortran/100821
* gfortran.dg/character_workout_1.f90: New test.
* gfortran.dg/character_workout_4.f90: New test.


diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 7eeef55..a6bcd2b 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -860,16 +860,25 @@ gfc_get_array_span (tree desc, gfc_expr *expr)
 	 size of the array. Attempt to deal with unbounded character
 	 types if possible. Otherwise, return NULL_TREE.  */
   tmp = gfc_get_element_type (TREE_TYPE (desc));
-  if (tmp && TREE_CODE (tmp) == ARRAY_TYPE
-	  && (TYPE_MAX_VALUE (TYPE_DOMAIN (tmp)) == NULL_TREE
-	  || integer_zerop (TYPE_MAX_VALUE (TYPE_DOMAIN (tmp)
-	{
-	  if (expr->expr_type == EXPR_VARIABLE
-	  && expr->ts.type == BT_CHARACTER)
-	tmp = fold_convert (gfc_array_index_type,
-gfc_get_expr_charlen (expr));
-	  else
-	tmp = NULL_TREE;
+  if (tmp && TREE_CODE (tmp) == ARRAY_TYPE && TYPE_STRING_FLAG (tmp))
+	{
+	  gcc_assert (expr->ts.type == BT_CHARACTER);
+	  
+	  tmp = gfc_get_character_len_in_bytes (tmp);
+	  
+	  if (tmp == NULL_TREE || integer_zerop (tmp))
+	{
+	  tree bs;
+
+	  tmp = gfc_get_expr_charlen (expr);
+	  tmp = fold_convert (gfc_array_index_type, tmp);
+	  bs = build_int_cst (gfc_array_index_type, expr->ts.kind);
+	  tmp = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, tmp, bs);
+	}
+	  
+	  tmp = (tmp && !integer_zerop (tmp))
+	? (fold_convert (gfc_array_index_type, tmp)) : (NULL_TREE);
 	}
   else
 	tmp

Re: [Patch, fortran] PR fortran/100683 - Array initialization refuses valid

2021-05-19 Thread José Rui Faustino de Sousa via Gcc-patches


Hi All!

And yes I forgot the patch...

Sorry...

Best regards,
José Rui

On 19/05/21 17:09, José Rui Faustino de Sousa wrote:

Hi all!

Proposed patch to:

PR100683 - Array initialization refuses valid

Patch tested only on x86_64-pc-linux-gnu.

Add call to simplify expression before parsing.

Thank you very much.

Best regards,
José Rui

Fortran: Fix bogus error

gcc/fortran/ChangeLog:

 PR fortran/100683
 * resolve.c (gfc_resolve_expr): Add call to gfc_simplify_expr.

gcc/testsuite/ChangeLog:

 PR fortran/100683
 * gfortran.dg/PR100683.f90: New test.



diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 747516f..e68391a 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7138,6 +7138,7 @@ gfc_resolve_expr (gfc_expr *e)
   /* Also try to expand a constructor.  */
   if (t)
 	{
+	  gfc_simplify_expr(e, 1);
 	  gfc_expression_rank (e);
 	  if (gfc_is_constant_expr (e) || gfc_is_expandable_expr (e))
 	gfc_expand_constructor (e, false);
diff --git a/gcc/testsuite/gfortran.dg/PR100683.f90 b/gcc/testsuite/gfortran.dg/PR100683.f90
new file mode 100644
index 000..6929bb5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100683.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+!
+! Test the fix for PR100683
+! 
+
+program main_p
+
+  implicit none
+
+  integer:: i
+  integer, parameter :: n = 11
+  integer, parameter :: u(*) = [(i, i=1,n)]
+
+  type :: foo_t
+integer :: i
+  end type foo_t
+
+  type, extends(foo_t) :: bar_t
+integer :: a(n)
+  end type bar_t
+  
+  type(bar_t), parameter :: a(*) = [(bar_t(i, u), i=1,n)]
+  type(bar_t):: b(n) = [(bar_t(i, u), i=1,n)]
+
+  if(any(a(:)%i/=u))   stop 1
+  do i = 1, n
+if(any(a(i)%a/=u)) stop 2
+  end do
+  if(any(b(:)%i/=u))   stop 3
+  do i = 1, n
+if(any(b(i)%a/=u)) stop 4
+  end do
+  stop
+
+end program main_p
+

[Patch, fortran] PR fortran/93308/93963/94327/94331/97046 problems raised by descriptor handling

2021-05-19 Thread José Rui Faustino de Sousa via Gcc-patches


Hi all!

Proposed patch to:

Bug 93308 - bind(c) subroutine changes lower bound of array argument in 
caller
Bug 93963 - Select rank mishandling allocatable and pointer arguments 
with bind(c)

Bug 94327 - Bind(c) argument attributes are incorrectly set
Bug 94331 - Bind(C) corrupts array descriptors
Bug 97046 - Bad interaction between lbound/ubound, allocatable arrays 
and bind(C) subroutine with dimension(..) parameter


Patch tested only on x86_64-pc-linux-gnu.

Fix attribute handling, which reflect a prior intermediate version of 
the Fortran standard.


CFI descriptors, in most cases, should not be copied out has they can 
corrupt the Fortran descriptor. Bounds will vary and the original 
Fortran bounds are definitively lost on conversion.


Thank you very much.

Best regards,
José Rui

Fortran: Fix attributtes and bounds in ISO_Fortran_binding.

gcc/fortran/ChangeLog:

PR fortran/93308
PR fortran/93963
PR fortran/94327
PR fortran/94331
PR fortran/97046
* trans-decl.c (convert_CFI_desc): Only copy out the descriptor
if necessary.
* trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Updated attribute
handling which reflect a previous intermediate version of the
standard. Only copy out the descriptor if necessary.

libgfortran/ChangeLog:

PR fortran/93308
PR fortran/93963
PR fortran/94327
PR fortran/94331
PR fortran/97046
* runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Add code
to verify the descriptor. Correct bounds calculation.
(gfc_desc_to_cfi_desc): Add code to verify the descriptor.

gcc/testsuite/ChangeLog:

PR fortran/93308
PR fortran/93963
PR fortran/94327
PR fortran/94331
PR fortran/97046
* gfortran.dg/ISO_Fortran_binding_1.f90: Add pointer attribute,
this test is still erroneous but now it compiles.
* gfortran.dg/bind_c_array_params_2.f90: Update regex to match
code changes.
* gfortran.dg/PR93308.f90: New test.
* gfortran.dg/PR93963.f90: New test.
* gfortran.dg/PR94327.c: New test.
* gfortran.dg/PR94327.f90: New test.
* gfortran.dg/PR94331.c: New test.
* gfortran.dg/PR94331.f90: New test.
* gfortran.dg/PR97046.f90: New test.
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 406b4ae..9fb4ef9 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -4519,22 +4519,28 @@ convert_CFI_desc (gfc_wrapped_block * block, gfc_symbol *sym)
   gfc_add_expr_to_block (_block, incoming);
   incoming = gfc_finish_block (_block);
 
-
   /* Convert the gfc descriptor back to the CFI type before going
 	 out of scope, if the CFI type was present at entry.  */
-  gfc_init_block (_block);
-  gfc_init_block ();
-
-  tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr);
-  outgoing = build_call_expr_loc (input_location,
-			gfor_fndecl_gfc_to_cfi, 2, tmp, gfc_desc_ptr);
-  gfc_add_expr_to_block (, outgoing);
+  outgoing = NULL_TREE;
+  if ((sym->attr.pointer || sym->attr.allocatable)
+	  && !sym->attr.value
+	  && sym->attr.intent != INTENT_IN)
+	{
+	  gfc_init_block (_block);
+	  gfc_init_block ();
 
-  outgoing = build3_v (COND_EXPR, present,
-			   gfc_finish_block (),
-			   build_empty_stmt (input_location));
-  gfc_add_expr_to_block (_block, outgoing);
-  outgoing = gfc_finish_block (_block);
+	  tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr);
+	  outgoing = build_call_expr_loc (input_location,
+	  gfor_fndecl_gfc_to_cfi, 2,
+	  tmp, gfc_desc_ptr);
+	  gfc_add_expr_to_block (, outgoing);
+
+	  outgoing = build3_v (COND_EXPR, present,
+			   gfc_finish_block (),
+			   build_empty_stmt (input_location));
+	  gfc_add_expr_to_block (_block, outgoing);
+	  outgoing = gfc_finish_block (_block);
+	}
 
   /* Add the lot to the procedure init and finally blocks.  */
   gfc_add_init_cleanup (block, incoming, outgoing);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index cce18d0..1f84d57 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5460,13 +5460,12 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
 	attribute = 1;
 }
 
-  /* If the formal argument is assumed shape and neither a pointer nor
- allocatable, it is unconditionally CFI_attribute_other.  */
-  if (fsym->as->type == AS_ASSUMED_SHAPE
-  && !fsym->attr.pointer && !fsym->attr.allocatable)
-   cfi_attribute = 2;
+  if (fsym->attr.pointer)
+cfi_attribute = 0;
+  else if (fsym->attr.allocatable)
+cfi_attribute = 1;
   else
-   cfi_attribute = attribute;
+cfi_attribute = 2;
 
   if (e->rank != 0)
 {
@@ -5574,10 +5573,15 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
   gfc_prepend_expr_to_block (>post, tmp);
 
   /* Transfer values

[Patch, fortran] PR fortran/100683 - Array initialization refuses valid

2021-05-19 Thread José Rui Faustino de Sousa via Gcc-patches


Hi all!

Proposed patch to:

PR100683 - Array initialization refuses valid

Patch tested only on x86_64-pc-linux-gnu.

Add call to simplify expression before parsing.

Thank you very much.

Best regards,
José Rui

Fortran: Fix bogus error

gcc/fortran/ChangeLog:

PR fortran/100683
* resolve.c (gfc_resolve_expr): Add call to gfc_simplify_expr.

gcc/testsuite/ChangeLog:

PR fortran/100683
* gfortran.dg/PR100683.f90: New test.

[Patch, fortran v2] PR fortran/92621 Problems with memory handling with allocatable intent(out) arrays with bind(c)

2021-04-26 Thread José Rui Faustino de Sousa via Gcc-patches


Hi all!

Proposed patch to:

PR92621 - Problems with memory handling with allocatable intent(out) 
arrays with bind(c)


Patch tested only on x86_64-pc-linux-gnu.

The code currently generated tries to deallocate the undefined 
artificial cfi.n pointer before it is associated with the allocatable array.


Since the cfi.n pointer is undefined attempting to free it is really a 
bad idea and it will frequently segfault.


Consequently, since the deallocation is done before the cfi.n pointer is 
associated with anything, the allocatable array is never freed, like it 
should, and it will be passed still allocated causing subsequent 
attempts to allocate it to fail.


Version 2 is basically a ping, fixes a typo, replaces an if block with a 
flag to make reviewing easier and replaces a call to malloc with calloc 
to make Valgrind happy.


Thank you very much.

Best regards,
José Rui

Fortran: Fix segfaults due to freeing undefined pointer [PR92621]

gcc/fortran/ChangeLog:

PR fortran/92621
* trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Add code to
deallocate allocatable intent(out) dummy array arguments and
slightly rearrange code.
(gfc_conv_procedure_call): Add a flag to avoid double frees,
removes unnecessary checks for bind(c) objects and obsolete
comments.

libgfortran/ChangeLog:

PR fortran/92621
* runtime/ISO_Fortran_binding.c (gfc_desc_to_cfi_desc): replaces
a call to malloc with calloc to make Valgrind happy.

gcc/testsuite/ChangeLog:

PR fortran/92621
* gfortran.dg/bind-c-intent-out.f90: Changes regex to match the
changes in code generation.
* gfortran.dg/PR92621.f90: Improved new test.

[Patch, fortran] PR fortran/100245 - ICE on automatic reallocation

2021-04-24 Thread José Rui Faustino de Sousa via Gcc-patches


Hi All!

Proposed patch to:

PR100245 - ICE on automatic reallocation.

Patch tested only on x86_64-pc-linux-gnu.

Add an if clause for handling derived types in the left hand side.

Thank you very much.

Best regards,
José Rui

Fortran: Fix ICE with automatic reallocation [PR100136]

gcc/fortran/ChangeLog:

PR fortran/100245
* trans-expr.c (trans_class_assignment): Add if clause to handle
derived type in the LHS.

gcc/testsuite/ChangeLog:

PR fortran/100245
* gfortran.dg/PR100245.f90: New test.

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 213f32b0a67..faced471918 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -10995,6 +10995,9 @@ trans_class_assignment (stmtblock_t *block, gfc_expr *lhs, gfc_expr *rhs,
   class_han = GFC_CLASS_TYPE_P (TREE_TYPE (lse->expr))
 	  ? gfc_class_data_get (lse->expr) : lse->expr;
 
+  if (!POINTER_TYPE_P (TREE_TYPE (class_han)))
+	class_han = gfc_build_addr_expr (NULL_TREE, class_han);
+  
   /* Allocate block.  */
   gfc_init_block ();
   gfc_allocate_using_malloc (, class_han, size, NULL_TREE);
diff --git a/gcc/testsuite/gfortran.dg/PR100245.f90 b/gcc/testsuite/gfortran.dg/PR100245.f90
new file mode 100644
index 000..1fc372a0d67
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100245.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+!
+! Test the fix for PR100245
+!
+
+program main_p
+
+  implicit none
+
+  type :: foo_t
+integer :: a
+  end type foo_t
+
+  integer, parameter :: a = 42
+  
+  class(foo_t), allocatable :: val
+  class(foo_t), allocatable :: rs1
+  type(foo_t),  allocatable :: rs2
+
+  allocate(val, source=foo_t(42))
+  if (val%a/=a) stop 1
+  rs1 = val
+  if (rs1%a/=a) stop 2
+  rs2 = val
+  if (rs2%a/=a) stop 3
+  deallocate(val, rs1, rs2)
+  stop
+
+end program main_p

[Patch, fortran] PR fortran/82376 - Duplicate function call using -fcheck=pointer

2021-04-22 Thread José Rui Faustino de Sousa via Gcc-patches


Hi All!

Proposed patch to:

PR82376 - Duplicate function call using -fcheck=pointer

Patch tested only on x86_64-pc-linux-gnu.

Evaluate function result and then pass a pointer, instead of a reference 
to the function itself, thus avoiding multiple evaluations of the function.


Thank you very much.

Best regards,
José Rui

Fortran: Fix double function call with -fcheck=pointer [PR]

gcc/fortran/ChangeLog:

PR fortran/82376
* trans-expr.c (gfc_conv_procedure_call): Evaluate function result
and then pass a pointer.

gcc/testsuite/ChangeLog:

PR fortran/82376
* gfortran.dg/PR82376.f90: New test.

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 213f32b0a67..b83b021755d 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6014,11 +6014,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 			|| (!e->value.function.esym
 && e->symtree->n.sym->attr.pointer))
 			&& fsym && fsym->attr.target)
-		{
-		  gfc_conv_expr (, e);
-		  parmse.expr = gfc_build_addr_expr (NULL_TREE, parmse.expr);
-		}
-
+		/* Make sure the function only gets called once.  */
+		gfc_conv_expr_reference (, e, false);
 	  else if (e->expr_type == EXPR_FUNCTION
 		   && e->symtree->n.sym->result
 		   && e->symtree->n.sym->result != e->symtree->n.sym
diff --git a/gcc/testsuite/gfortran.dg/PR82376.f90 b/gcc/testsuite/gfortran.dg/PR82376.f90
new file mode 100644
index 000..cea1c2ae211
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR82376.f90
@@ -0,0 +1,55 @@
+! { dg-do run }
+!
+! Test the fix for PR82376
+!
+
+program main_p
+
+  integer, parameter :: n = 10
+
+  type :: foo_t
+integer, pointer :: v =>null()
+  end type foo_t
+
+  integer, save :: pcnt = 0
+  
+  type(foo_t) :: int
+  integer :: i
+
+  do i = 1, n
+call init(int, i)
+if(.not.associated(int%v)) stop 1
+if(int%v/=i) stop 2
+if(pcnt/=i) stop 3
+  end do
+
+contains
+
+  function new(data) result(this)
+integer, target, intent(in) :: data
+
+integer, pointer :: this
+
+nullify(this)
+this => data
+pcnt = pcnt + 1
+return
+  end function new
+
+  subroutine init(this, data)
+type(foo_t), intent(out) :: this
+integer, intent(in)  :: data
+
+call set(this, new(data))
+return
+  end subroutine init
+
+  subroutine set(this, that)
+type(foo_t), intent(inout) :: this
+integer, target, intent(in):: that
+
+this%v => that
+return
+  end subroutine set
+  
+end program main_p

[Patch, fortran] PR fortran/100136 - ICE, regression, using flag -fcheck=pointer

2021-04-18 Thread José Rui Faustino de Sousa via Gcc-patches


Hi All!

Proposed patch to:

PR100136 - ICE, regression, using flag -fcheck=pointer

Patch tested only on x86_64-pc-linux-gnu.

Add handling for pointer expressions.

Thank you very much.

Best regards,
José Rui

Fortran: Fix ICE with -fcheck=pointer [PR100136]

gcc/fortran/ChangeLog:

PR fortran/100136
* trans-expr.c (gfc_conv_procedure_call): Add handling of pointer
expressions.

gcc/testsuite/ChangeLog:

PR fortran/100136
* gfortran.dg/PR100136.f90: New test.

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 213f32b0a67..249b3904cdb 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6782,16 +6782,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	  else
 		goto end_pointer_check;
 
+	  tmp = parmse.expr;
 	  if (fsym && fsym->ts.type == BT_CLASS)
 		{
-		  tmp = build_fold_indirect_ref_loc (input_location,
-		  parmse.expr);
+		  if (POINTER_TYPE_P (tmp))
+		tmp = build_fold_indirect_ref_loc (input_location, tmp);
 		  tmp = gfc_class_data_get (tmp);
 		  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
 		tmp = gfc_conv_descriptor_data_get (tmp);
 		}
-	  else
-		tmp = parmse.expr;
 
 	  /* If the argument is passed by value, we need to strip the
 		 INDIRECT_REF.  */
diff --git a/gcc/testsuite/gfortran.dg/PR100136.f90 b/gcc/testsuite/gfortran.dg/PR100136.f90
new file mode 100644
index 000..931a4796846
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100136.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+! { dg-options "-fcheck=pointer" }
+! { dg-shouldfail "Argument not allocated" }
+! { dg-output "Fortran runtime error: Allocatable actual argument 'c_init2' is not allocated" }
+!
+! Tests fix for PR100136
+! 
+! Test cut down from PR58586
+! 
+
+module test_pr58586_mod
+  implicit none
+
+  type :: a
+  end type
+
+  type :: c
+ type(a), allocatable :: a
+  end type
+
+contains
+
+  subroutine add_class_c (d)
+class(c), value :: d
+  end subroutine
+
+  class(c) function c_init2()
+allocatable :: c_init2
+  end function
+
+end module test_pr58586_mod
+
+program test_pr58586
+  use test_pr58586_mod
+
+  ! This needs to execute, to see whether the segfault at runtime is resolved
+  call add_class_c(c_init2())
+
+end program
+

[Patch, fortran] PR fortran/100132 - Optimization breaks pointer association

2021-04-17 Thread José Rui Faustino de Sousa via Gcc-patches


Hi All!

Proposed patch to:

PR100132 - Optimization breaks pointer association.

Patch tested only on x86_64-pc-linux-gnu.

Correct pointer attributes when passing polymorphic pointers.

Thank you very much.

Best regards,
José Rui

Fortran: Fix function attributes [PR100132]

gcc/fortran/ChangeLog:

PR fortran/100132
* trans-types.c (create_fn_spec): fix function attributes when
passing polymorphic pointers.

gcc/testsuite/ChangeLog:

PR fortran/100132
* gfortran.dg/PR100132.f90: New test.

diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 9f21b3ee780..6cf85dc9a41 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -2981,12 +2981,25 @@ create_fn_spec (gfc_symbol *sym, tree fntype)
   for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)
 if (spec_len < sizeof (spec))
   {
-	if (!f->sym || f->sym->attr.pointer || f->sym->attr.target
+	bool is_class = false;
+	bool is_pointer = false;
+
+	if (f->sym)
+	  {
+	symbol_attribute *attr = NULL;
+
+	is_class = f->sym->ts.type == BT_CLASS && CLASS_DATA (f->sym)
+	  && f->sym->attr.class_ok;
+	attr = is_class ? &(CLASS_DATA (f->sym)->attr) : &(f->sym->attr);
+	is_pointer = is_class ? attr->class_pointer : attr->pointer;
+	  }
+
+	if (f->sym == NULL || is_pointer || f->sym->attr.target
 	|| f->sym->attr.external || f->sym->attr.cray_pointer
 	|| (f->sym->ts.type == BT_DERIVED
 		&& (f->sym->ts.u.derived->attr.proc_pointer_comp
 		|| f->sym->ts.u.derived->attr.pointer_comp))
-	|| (f->sym->ts.type == BT_CLASS
+	|| (is_class
 		&& (CLASS_DATA (f->sym)->ts.u.derived->attr.proc_pointer_comp
 		|| CLASS_DATA (f->sym)->ts.u.derived->attr.pointer_comp))
 	|| (f->sym->ts.type == BT_INTEGER && f->sym->ts.is_c_interop))
diff --git a/gcc/testsuite/gfortran.dg/PR100132.f90 b/gcc/testsuite/gfortran.dg/PR100132.f90
new file mode 100644
index 000..aec0fef3d26
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100132.f90
@@ -0,0 +1,81 @@
+! { dg-do run }
+!
+! Test the fix for PR100132
+!
+
+module main_m
+
+  implicit none
+
+  private
+
+  public :: &
+foo_t
+
+  public :: &
+set,&
+get
+  
+  type :: foo_t
+!private
+integer :: i
+  end type foo_t
+
+  type(foo_t), save, pointer :: data => null()
+  
+contains
+
+  subroutine set(this)
+class(foo_t), pointer, intent(in) :: this
+
+if(associated(data)) stop 1
+data => this
+return
+  end subroutine set
+
+  subroutine get(this)
+type(foo_t), pointer, intent(out) :: this
+
+if(.not.associated(data)) stop 4
+this => data
+nullify(data)
+return
+  end subroutine get
+
+end module main_m
+
+program main_p
+
+  use :: main_m, only: &
+foo_t, set, get
+
+  implicit none
+
+  integer, parameter :: n = 1000
+
+  type(foo_t), pointer :: ps
+  type(foo_t),  target :: s
+  integer  :: i, j, yay, nay
+
+  yay = 0
+  nay = 0
+  do i = 1, n
+s%i = i
+call set(s)
+call get(ps)
+if(.not.associated(ps)) stop 13
+j = ps%i
+if(i/=j) stop 14
+if(i/=s%i) stop 15
+if(ps%i/=s%i) stop 16
+if(associated(ps, s))then
+  yay = yay + 1
+else
+  nay = nay + 1
+end if
+  end do
+  if((yay/=n).or.(nay/=0)) stop 17
+  stop
+
+end program main_p
+

[Patch, fortran v2] PR fortran/84006, PR fortran/100027 - ICE on storage_size with polymorphic argument

2021-04-16 Thread José Rui Faustino de Sousa via Gcc-patches


Hi All!

Proposed patch to:
PR84006 - [8/9/10/11 Regression] ICE in storage_size() with CLASS entity
PR100027 - ICE on storage_size with polymorphic argument

Patch tested only on x86_64-pc-linux-gnu.

Add branch to if clause to handle polymorphic objects, not sure if I got 
all possible variations...


Now with a new and extended test.

Thank you very much.

Best regards,
José Rui

Fortran: Fix ICE using storage_size intrinsic [PR84006, PR100027]

gcc/fortran/ChangeLog:

PR fortran/84006
PR fortran/100027
* trans-intrinsic.c (gfc_conv_intrinsic_storage_size): add if
clause branch to handle polymorphic objects.

gcc/testsuite/ChangeLog:

PR fortran/84006
* gfortran.dg/PR84006.f90: New test.

PR fortran/100027
* gfortran.dg/PR100027.f90: New test.
diff --git a/configure b/configure
index 504f6410274..1be51708c03 100755
--- a/configure
+++ b/configure
@@ -756,6 +756,7 @@ infodir
 docdir
 oldincludedir
 includedir
+runstatedir
 localstatedir
 sharedstatedir
 sysconfdir
@@ -922,6 +923,7 @@ datadir='${datarootdir}'
 sysconfdir='${prefix}/etc'
 sharedstatedir='${prefix}/com'
 localstatedir='${prefix}/var'
+runstatedir='${localstatedir}/run'
 includedir='${prefix}/include'
 oldincludedir='/usr/include'
 docdir='${datarootdir}/doc/${PACKAGE}'
@@ -1174,6 +1176,15 @@ do
   | -silent | --silent | --silen | --sile | --sil)
 silent=yes ;;
 
+  -runstatedir | --runstatedir | --runstatedi | --runstated \
+  | --runstate | --runstat | --runsta | --runst | --runs \
+  | --run | --ru | --r)
+ac_prev=runstatedir ;;
+  -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \
+  | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \
+  | --run=* | --ru=* | --r=*)
+runstatedir=$ac_optarg ;;
+
   -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
 ac_prev=sbindir ;;
   -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
@@ -1311,7 +1322,7 @@ fi
 for ac_var in	exec_prefix prefix bindir sbindir libexecdir datarootdir \
 		datadir sysconfdir sharedstatedir localstatedir includedir \
 		oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
-		libdir localedir mandir
+		libdir localedir mandir runstatedir
 do
   eval ac_val=\$$ac_var
   # Remove trailing slashes.
@@ -1471,6 +1482,7 @@ Fine tuning of the installation directories:
   --sysconfdir=DIRread-only single-machine data [PREFIX/etc]
   --sharedstatedir=DIRmodifiable architecture-independent data [PREFIX/com]
   --localstatedir=DIR modifiable single-machine data [PREFIX/var]
+  --runstatedir=DIR   modifiable per-process data [LOCALSTATEDIR/run]
   --libdir=DIRobject code libraries [EPREFIX/lib]
   --includedir=DIRC header files [PREFIX/include]
   --oldincludedir=DIR C header files for non-gcc [/usr/include]
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 5e53d1162fa..6536c121f2b 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -8353,10 +8353,16 @@ gfc_conv_intrinsic_storage_size (gfc_se *se, gfc_expr *expr)
   if (arg->ts.type == BT_CLASS)
 	{
 	  if (arg->rank > 0)
-	tmp = gfc_class_vtab_size_get (
-		 GFC_DECL_SAVED_DESCRIPTOR (arg->symtree->n.sym->backend_decl));
+	{
+	  if (TREE_CODE (argse.expr) == COMPONENT_REF)
+		tmp = TREE_OPERAND (argse.expr, 0);
+	  else
+		tmp = GFC_DECL_SAVED_DESCRIPTOR (
+		  arg->symtree->n.sym->backend_decl);
+	}
 	  else
-	tmp = gfc_class_vtab_size_get (TREE_OPERAND (argse.expr, 0));
+	tmp = TREE_OPERAND (argse.expr, 0);
+	  tmp = gfc_class_vtab_size_get (tmp);
 	  tmp = fold_convert (result_type, tmp);
 	  goto done;
 	}
diff --git a/gcc/testsuite/gfortran.dg/PR100027.f90 b/gcc/testsuite/gfortran.dg/PR100027.f90
new file mode 100644
index 000..4cee549d055
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100027.f90
@@ -0,0 +1,425 @@
+! { dg-do run }
+!
+! Test fix for PR100027
+!
+! in colaboration with Tobias Burnus.
+! 
+
+program main_p
+
+  implicit none
+
+  integer, parameter :: n = 111
+
+  integer, parameter :: ikind = kind(n)
+  integer, parameter :: bsize = 8
+  integer, parameter :: isize = bit_size(n)
+  integer, parameter :: dsize = (n+1)*isize
+  
+  type :: foo_t
+integer :: i
+  end type foo_t
+
+  type, extends(foo_t) :: bar_t
+integer :: j(n)
+  end type bar_t
+  
+  type :: box_t
+class(foo_t), allocatable :: x, y(:)
+  end type box_t
+
+  integer,   target :: ain(n)
+  type(foo_t),   target :: afd(n)
+  type(bar_t),   target :: abd(n)
+  type(box_t),   target :: afx(n)
+  type(box_t),   target :: abx(n)
+  !
+  class(*), pointer :: spu
+  class(*), pointer :: apu(:)
+  !
+  class(foo_t), pointer :: spf
+  class(foo_t), pointer :: apf(:)
+  !
+  class(bar_t), pointer :: spb
+  class(bar_t), pointer :: apb(:)
+  !
+  class(box_t), pointer :: spx
+  class(box_t), pointer :: apx(:)
+  !
+  integer   :: i, j, so, ss
+
+  ain = [(i, i=1,n)]
+

Patch, fortran] PR fortran/100120 - associated intrinsic failure

2021-04-16 Thread José Rui Faustino de Sousa via Gcc-patches


Hi All!

Proposed patch to:

PR100120 - associated intrinsic failure

Patch tested only on x86_64-pc-linux-gnu.

Add code to ensure that pointers have the correct dynamic type.

The patch depends on PR100097 and PR100098.

Thank you very much.

Best regards,
José Rui

Fortran: Fix associated intrinsic failure [PR100120]

gcc/fortran/ChangeLog:

PR fortran/100120
* trans-array.c (gfc_conv_expr_descriptor): add code to ensure
that pointers have the correct dynamic type.

gcc/testsuite/ChangeLog:

PR fortran/100120
* gfortran.dg/PR100120.f90: New test.

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index ca90142530c..0ef6c788465 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -7598,6 +7598,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
   int dim, ndim, codim;
   tree parm;
   tree parmtype;
+  tree dtype;
   tree stride;
   tree from;
   tree to;
@@ -7670,24 +7671,24 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 	  loop.from[dim] = gfc_index_one_node;
 	}
 
+  /* The destination must carry the dynamic type of the expression...  */
   desc = info->descriptor;
+  if (expr->ts.type == BT_CHARACTER && expr->ts.deferred)
+	parmtype = gfc_typenode_for_spec (>ts);
+  else
+	parmtype = gfc_get_element_type (TREE_TYPE (desc));
+
+  /* ...But the destination has it's own rank and shape.  */
+  parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen, codim,
+	loop.from, loop.to, 0,
+	GFC_ARRAY_UNKNOWN, false);
+
   if (se->direct_byref && !se->byref_noassign)
-	{
-	  /* For pointer assignments we fill in the destination.  */
-	  parm = se->expr;
-	  parmtype = TREE_TYPE (parm);
-	}
+	/* For pointer assignments we fill in the destination.  */
+	parm = se->expr;
   else
 	{
 	  /* Otherwise make a new one.  */
-	  if (expr->ts.type == BT_CHARACTER && expr->ts.deferred)
-	parmtype = gfc_typenode_for_spec (>ts);
-	  else
-	parmtype = gfc_get_element_type (TREE_TYPE (desc));
-
-	  parmtype = gfc_get_array_type_bounds (parmtype, loop.dimen, codim,
-		loop.from, loop.to, 0,
-		GFC_ARRAY_UNKNOWN, false);
 	  parm = gfc_create_var (parmtype, "parm");
 
 	  /* When expression is a class object, then add the class' handle to
@@ -7731,8 +7732,18 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
  the offsets because all elements are within the array data.  */
 
   /* Set the dtype.  */
+  if (expr->expr_type == EXPR_VARIABLE
+	  && expr->symtree->n.sym->attr.dummy
+	  && IS_CLASS_ARRAY (expr->symtree->n.sym))
+	{
+	  tmp = gfc_get_class_from_gfc_expr (expr);
+	  tmp = gfc_class_data_get (tmp);
+	  dtype = gfc_conv_descriptor_dtype (tmp);
+	}
+  else
+	dtype = gfc_get_dtype (parmtype);
   tmp = gfc_conv_descriptor_dtype (parm);
-  gfc_add_modify (, tmp, gfc_get_dtype (parmtype));
+  gfc_add_modify (, tmp, dtype);
 
   /* The 1st element in the section.  */
   base = gfc_index_zero_node;
diff --git a/gcc/testsuite/gfortran.dg/PR100120.f90 b/gcc/testsuite/gfortran.dg/PR100120.f90
new file mode 100644
index 000..58a22d72c26
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100120.f90
@@ -0,0 +1,166 @@
+! { dg-do run }
+!
+! Tests fix for PR100120
+!
+
+program main_p
+
+  implicit none
+
+  integer, parameter :: n = 11
+
+  type :: foo_t
+integer :: i
+  end type foo_t
+
+  type, extends(foo_t) :: bar_t
+integer :: j(n)
+  end type bar_t
+  
+  class(*), pointer :: spu
+  class(*), pointer :: apu(:)
+  class(foo_t), pointer :: spf
+  class(foo_t), pointer :: apf(:)
+  class(bar_t), pointer :: spb
+  class(bar_t), pointer :: apb(:)
+  type(foo_t),   target :: afd(n)
+  type(bar_t),   target :: abd(n)
+  integer,   target :: ain(n)
+  integer   :: i
+
+  ain = [(i, i=1,n)]
+  afd%i = ain
+  abd%i = ain
+  do i = 1, n
+abd(i)%j = ain
+  end do
+
+  apu => ain
+  if(.not.associated(apu)) stop 1
+  if(.not.associated(apu, ain)) stop 2
+  select type(apu)
+  type is(integer)
+if(any(apu/=ain)) stop 3
+  class default
+stop 4
+  end select
+  spu => ain(n)
+  if(.not.associated(spu)) stop 5
+  if(.not.associated(spu, ain(n))) stop 6
+  select type(spu)
+  type is(integer)
+if(spu/=n) stop 7
+  class default
+stop 8
+  end select
+
+  apu => afd
+  if(.not.associated(apu)) stop 10
+  if(.not.associated(apu, afd)) stop 11
+  select type(apu)
+  type is(foo_t)
+if(any(apu%i/=afd%i)) stop 12
+  class default
+stop 13
+  end select
+  spu => afd(n)
+  if(.not.associated(spu)) stop 14
+  if(.not.associated(spu, afd(n))) stop 15
+  select type(spu)
+  type is(foo_t)
+if(spu%i/=n) stop 16
+  class default
+stop 17
+  end select
+  
+  apu => abd
+  if(.not.associated(apu)) stop 20
+  if(.not.associated(apu, abd)) stop 21
+  select type(apu)
+  type is(bar_t)
+if(any(apu%i/=abd%i)) stop 22
+do i = 1, n
+

Patch, fortran] PR fortran/100103 - Automatic reallocation fails inside select rank

2021-04-15 Thread José Rui Faustino de Sousa via Gcc-patches


Hi All!

Proposed patch to:

PR100103 - Automatic reallocation fails inside select rank

Patch tested only on x86_64-pc-linux-gnu.

Add select rank temporary associated names as possible targets of 
automatic reallocation.


The patch depends on PR100097 and PR100098.

Thank you very much.

Best regards,
José Rui

Fortran: Fix automatic reallocation inside select rank [PR100103]

gcc/fortran/ChangeLog:

PR fortran/100103
* trans-array.c (gfc_is_reallocatable_lhs): add select rank
temporary associate names as possible targets of automatic
reallocation.

gcc/testsuite/ChangeLog:

PR fortran/100103
* gfortran.dg/PR100103.f90: New test.

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index be5eb89350f..99225e70d5d 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -10048,7 +10048,7 @@ gfc_is_reallocatable_lhs (gfc_expr *expr)
 
   /* An allocatable class variable with no reference.  */
   if (sym->ts.type == BT_CLASS
-  && !sym->attr.associate_var
+  && (!sym->attr.associate_var || sym->attr.select_rank_temporary)
   && CLASS_DATA (sym)->attr.allocatable
   && expr->ref
   && ((expr->ref->type == REF_ARRAY && expr->ref->u.ar.type == AR_FULL
@@ -10063,7 +10063,7 @@ gfc_is_reallocatable_lhs (gfc_expr *expr)
 
   /* An allocatable variable.  */
   if (sym->attr.allocatable
-  && !sym->attr.associate_var
+  && (!sym->attr.associate_var || sym->attr.select_rank_temporary)
   && expr->ref
   && expr->ref->type == REF_ARRAY
   && expr->ref->u.ar.type == AR_FULL)
diff --git a/gcc/testsuite/gfortran.dg/PR100103.f90 b/gcc/testsuite/gfortran.dg/PR100103.f90
new file mode 100644
index 000..756fd5824c9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100103.f90
@@ -0,0 +1,81 @@
+! { dg-do run }
+!
+! Test the fix for PR100103
+!
+
+program main_p
+
+  implicit none
+
+  integer:: i
+  integer, parameter :: n = 11
+  
+  type :: foo_t
+integer :: i
+  end type foo_t
+  
+  type(foo_t), parameter :: a(*) = [(foo_t(i), i=1,n)]
+
+  type(foo_t),  allocatable :: bar_d(:)
+  class(foo_t), allocatable :: bar_p(:)
+  class(*), allocatable :: bar_u(:)
+
+
+  call foo_d(bar_d)
+  if(.not.allocated(bar_d)) stop 1
+  if(any(bar_d%i/=a%i)) stop 2
+  deallocate(bar_d)
+  call foo_p(bar_p)
+  if(.not.allocated(bar_p)) stop 3
+  if(any(bar_p%i/=a%i)) stop 4
+  deallocate(bar_p)
+  call foo_u(bar_u)
+  if(.not.allocated(bar_u)) stop 5
+  select type(bar_u)
+  type is(foo_t)
+if(any(bar_u%i/=a%i)) stop 6
+  class default
+stop 7
+  end select
+  deallocate(bar_u)
+  stop
+
+contains
+
+  subroutine foo_d(that)
+type(foo_t), allocatable, intent(out) :: that(..)
+
+select rank(that)
+rank(1)
+  that = a
+rank default
+  stop 8
+end select
+return
+  end subroutine foo_d
+
+  subroutine foo_p(that)
+class(foo_t), allocatable, intent(out) :: that(..)
+
+select rank(that)
+rank(1)
+  that = a
+rank default
+  stop 9
+end select
+return
+  end subroutine foo_p
+
+  subroutine foo_u(that)
+class(*), allocatable, intent(out) :: that(..)
+
+select rank(that)
+rank(1)
+  that = a
+rank default
+  stop 10
+end select
+return
+  end subroutine foo_u
+
+end program main_p

Patch, fortran] PR fortran/100097 PR fortran/100098 - [Unlimited] polymorphic pointers and allocatables have incorrect rank

2021-04-15 Thread José Rui Faustino de Sousa via Gcc-patches


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.

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 be5eb89350f..acd44a347e2 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -10808,6 +10808,52 @@ 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);
+  type = TREE_TYPE (descriptor);
+
+  if (type == NULL || !GFC_DESCRIPTOR_TYPE_P (type))
+return;
+
+  gfc_save_backend_locus ();
+  gfc_set_backend_locus (>declared_at);
+  gfc_init_block ();
+
+  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 (, tmp);
+
+  gfc_add_init_cleanup (block, gfc_finish_block (), NULL_TREE);
+  gfc_restore_backend_locus ();
+}
+
+
 /* 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 e4d443d7118..d2768f1be61 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 34a0d49bae7..6a0d80bccb0 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -4929,7 +4929,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)
@@ -5013,6 +5013,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..926eb6cc779
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100097.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+!
+! Test the fix for PR100097
+!
+
+program main_p
+
+  implicit none
+
+  class(*), pointer :: bar_p(:)
+  class(*), allocatable :: bar_a(:)
+
+  call foo_p(bar_p)
+  call

[Patch, fortran] PR fortran/100094 - Undefined pointers have incorrect rank when using optimization

2021-04-15 Thread José Rui Faustino de Sousa via Gcc-patches


Hi All!

Proposed patch to:

PR100094 - Undefined pointers have incorrect rank when using optimization

Patch tested only on x86_64-pc-linux-gnu.

Pointers, and allocatables, must carry TKR information even when 
undefined. The patch adds code to initialize both pointers and 
allocatables element size, rank and type as soon as possible to do so. 
Latter initialization will work for allocatables, but not for pointers 
since one can not test meaningfully the association status of undefined 
pointers.


Thank you very much.

Best regards,
José Rui

Fortran: Add missing TKR initialization [PR100094]

gcc/fortran/ChangeLog:

PR fortran/100094
* trans-array.c (gfc_trans_deferred_array): Add code to initialize
pointers and allocatables with correct TKR parameters.

gcc/testsuite/ChangeLog:

PR fortran/100094
* gfortran.dg/PR100094.f90: New test.

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index be5eb89350f..2bd69724366 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -10920,6 +10920,20 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
 	}
 }
 
+  /* Set initial TKR for pointers and allocatables */
+  if (GFC_DESCRIPTOR_TYPE_P (type)
+  && (sym->attr.pointer || sym->attr.allocatable))
+{
+  tree etype;
+
+  gcc_assert (sym->as && sym->as->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 (sym->as->rank, etype));
+  gfc_add_expr_to_block (, tmp);
+}
   gfc_restore_backend_locus ();
   gfc_init_block ();
 
diff --git a/gcc/testsuite/gfortran.dg/PR100094.f90 b/gcc/testsuite/gfortran.dg/PR100094.f90
new file mode 100644
index 000..f2f7f1631dc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100094.f90
@@ -0,0 +1,37 @@
+! { dg-do run }
+!
+! Test the fix for PR100094
+!
+
+program foo_p
+
+  implicit none
+
+  integer, parameter :: n = 11
+  
+  integer, pointer :: pout(:)
+  integer,  target :: a(n)
+  integer  :: i
+  
+  a = [(i, i=1,n)]
+  call foo(pout)
+  if(.not.associated(pout)) stop 1
+  if(.not.associated(pout, a)) stop 2
+  if(any(pout/=a)) stop 3
+  stop
+
+contains
+
+  subroutine foo(that)
+integer, pointer, intent(out) :: that(..)
+
+select rank(that)
+rank(1)
+  that => a
+rank default
+  stop 4
+end select
+return
+  end subroutine foo
+
+end program foo_p

[Patch, fortran] PR fortran/100029 - ICE on storage_size with polymorphic argument, PR fortran/100040 - Wrong code with intent out assumed-rank allocatable

2021-04-11 Thread José Rui Faustino de Sousa via Gcc-patches


Hi All!

Proposed patch to:

PR100040 - Wrong code with intent out assumed-rank allocatable
PR100029 - ICE on subroutine call with allocatable polymorphic 
assumed-rank argument


Patch tested only on x86_64-pc-linux-gnu.

Made sure the code also recognized assumed-rank arrays as full arrays.

Changed the order of free and class to class conversion so that the free 
occurs first so that there are no problems with freeing an unexpected 
type of transformed class.


Thank you very much.

Best regards,
José Rui

Fortran: Fix ICE and wrong code emission [PR100029, PR100040]

gcc/fortran/ChangeLog:

PR fortran/100040
* trans-expr.c (gfc_conv_class_to_class): add code to have
assumed-rank arrays recognized as full arrays and fix the type
of the array assignment.

PR fortran/100029
* trans-expr.c (gfc_conv_procedure_call): change order of code
blocks, such that the free occurs first.

gcc/testsuite/ChangeLog:

PR fortran/100029
* gfortran.dg/PR100029.f90: New test.

PR fortran/100040
* gfortran.dg/PR100040.f90: New test.

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 2fa17b36c03..35b784ab782 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1099,8 +1099,10 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts,
 return;
 
   /* Test for FULL_ARRAY.  */
-  if (e->rank == 0 && gfc_expr_attr (e).codimension
-  && gfc_expr_attr (e).dimension)
+  if (e->rank == 0
+  && ((gfc_expr_attr (e).codimension && gfc_expr_attr (e).dimension)
+	  || (class_ts.u.derived->components->as
+	  && class_ts.u.derived->components->as->type == AS_ASSUMED_RANK)))
 full_array = true;
   else
 gfc_is_class_array_ref (e, _array);
@@ -1148,8 +1150,12 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts,
 	  && e->rank != class_ts.u.derived->components->as->rank)
 	{
 	  if (e->rank == 0)
-	gfc_add_modify (>post, gfc_class_data_get (parmse->expr),
-			gfc_conv_descriptor_data_get (ctree));
+	{
+	  tmp = gfc_class_data_get (parmse->expr);
+	  gfc_add_modify (>post, tmp,
+			  fold_convert (TREE_TYPE (tmp),
+	 gfc_conv_descriptor_data_get (ctree)));
+	}
 	  else
 	class_array_data_assign (>post, parmse->expr, ctree, true);
 	}
@@ -6111,23 +6117,6 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		base_object = build_fold_indirect_ref_loc (input_location,
 			   parmse.expr);
 
-		  /* A class array element needs converting back to be a
-		 class object, if the formal argument is a class object.  */
-		  if (fsym && fsym->ts.type == BT_CLASS
-			&& e->ts.type == BT_CLASS
-			&& ((CLASS_DATA (fsym)->as
-			 && CLASS_DATA (fsym)->as->type == AS_ASSUMED_RANK)
-			|| CLASS_DATA (e)->attr.dimension))
-		gfc_conv_class_to_class (, e, fsym->ts, false,
- fsym->attr.intent != INTENT_IN
- && (CLASS_DATA (fsym)->attr.class_pointer
-	 || CLASS_DATA (fsym)->attr.allocatable),
- fsym->attr.optional
- && e->expr_type == EXPR_VARIABLE
- && e->symtree->n.sym->attr.optional,
- CLASS_DATA (fsym)->attr.class_pointer
- || CLASS_DATA (fsym)->attr.allocatable);
-
 		  /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
 		 allocated on entry, it must be deallocated.  */
 		  if (fsym && fsym->attr.intent == INTENT_OUT
@@ -6186,6 +6175,22 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 
 		  gfc_add_expr_to_block (>pre, tmp);
 		}
+		  /* A class array element needs converting back to be a
+		 class object, if the formal argument is a class object.  */
+		  if (fsym && fsym->ts.type == BT_CLASS
+			&& e->ts.type == BT_CLASS
+			&& ((CLASS_DATA (fsym)->as
+			 && CLASS_DATA (fsym)->as->type == AS_ASSUMED_RANK)
+			|| CLASS_DATA (e)->attr.dimension))
+		gfc_conv_class_to_class (, e, fsym->ts, false,
+ fsym->attr.intent != INTENT_IN
+ && (CLASS_DATA (fsym)->attr.class_pointer
+	 || CLASS_DATA (fsym)->attr.allocatable),
+ fsym->attr.optional
+ && e->expr_type == EXPR_VARIABLE
+ && e->symtree->n.sym->attr.optional,
+ CLASS_DATA (fsym)->attr.class_pointer
+ || CLASS_DATA (fsym)->attr.allocatable);
 
 		  if (fsym && (fsym->ts.type == BT_DERIVED
 			   || fsym->ts.type == BT_ASSUMED)
diff --git a/gcc/testsuite/gfortran.dg/PR100029.f90 b/gcc/testsuite/gfortran.dg/PR100029.f90
new file mode 100644
index 000..1fef06fd2d3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100029.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+!
+! Test the fix for PR100029
+!
+
+program foo_p
+
+  implicit none
+
+  type :: foo_t
+  end type foo_t
+  
+  class(foo_t), allocatable :: pout
+
+  call foo_s(pout)
+  stop
+
+contains
+
+  subroutine foo_s(that)
+class(foo_t), allocatable, intent(out) :: that(..)
+
+return
+  end subroutine foo_s
+

[Patch, fortran] PR fortran/84006, PR fortran/100027 - ICE on storage_size with polymorphic argument

2021-04-10 Thread José Rui Faustino de Sousa via Gcc-patches


Hi All!

Proposed patch to:
PR84006 - [8/9/10/11 Regression] ICE in storage_size() with CLASS entity
PR100027 - ICE on storage_size with polymorphic argument

Patch tested only on x86_64-pc-linux-gnu.

Add branch to if clause to handle polymorphic objects, not sure if I got 
all possible variations...


Thank you very much.

Best regards,
José Rui

Fortran: Fix ICE using storage_size intrinsic [PR84006, PR100027]

gcc/fortran/ChangeLog:

PR fortran/84006
PR fortran/100027
* trans-intrinsic.c (gfc_conv_intrinsic_storage_size): add if
clause branch to handle polymorphic objects.

gcc/testsuite/ChangeLog:

PR fortran/84006
* gfortran.dg/PR84006.f90: New test.

PR fortran/100027
* gfortran.dg/PR100027.f90: New test.

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 5e53d1162fa..6536c121f2b 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -8353,10 +8353,16 @@ gfc_conv_intrinsic_storage_size (gfc_se *se, gfc_expr *expr)
   if (arg->ts.type == BT_CLASS)
 	{
 	  if (arg->rank > 0)
-	tmp = gfc_class_vtab_size_get (
-		 GFC_DECL_SAVED_DESCRIPTOR (arg->symtree->n.sym->backend_decl));
+	{
+	  if (TREE_CODE (argse.expr) == COMPONENT_REF)
+		tmp = TREE_OPERAND (argse.expr, 0);
+	  else
+		tmp = GFC_DECL_SAVED_DESCRIPTOR (
+		  arg->symtree->n.sym->backend_decl);
+	}
 	  else
-	tmp = gfc_class_vtab_size_get (TREE_OPERAND (argse.expr, 0));
+	tmp = TREE_OPERAND (argse.expr, 0);
+	  tmp = gfc_class_vtab_size_get (tmp);
 	  tmp = fold_convert (result_type, tmp);
 	  goto done;
 	}
diff --git a/gcc/testsuite/gfortran.dg/PR100027.f90 b/gcc/testsuite/gfortran.dg/PR100027.f90
new file mode 100644
index 000..dc565872cac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100027.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+!
+
+program foo_p
+
+  implicit none
+
+  integer, parameter :: n = 11
+  
+  type :: foo_t
+  end type foo_t
+
+  type, extends(foo_t) :: bar_t
+  end type bar_t
+
+  class(*), pointer :: apu(:)
+  class(foo_t), pointer :: apf(:)
+  class(bar_t), pointer :: apb(:)
+  type(bar_t),   target :: atb(n)
+
+  integer :: m
+  
+  apu => atb
+  m = storage_size(apu)
+  apf => atb
+  m = storage_size(apf)
+  apb => atb
+  m = storage_size(apb)
+
+end program foo_p
+
diff --git a/gcc/testsuite/gfortran.dg/PR84006.f90 b/gcc/testsuite/gfortran.dg/PR84006.f90
new file mode 100644
index 000..41e2161b6e5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR84006.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+!
+
+program p
+  type t
+integer i
+  end type
+  integer rslt
+  class(t), allocatable :: t_alloc(:)
+  allocate (t_alloc(10), source=t(1))
+  rslt = storage_size(t_alloc)
+end program p

[Patch, fortran] PR fortran/100024 PR fortran/100025 ICE on subroutine missing explicit interface

2021-04-10 Thread José Rui Faustino de Sousa via Gcc-patches


Hi all!

Proposed patch to PR100024 & PR100025 - ICE on missing polymorphic argument.

Patch tested only on x86_64-pc-linux-gnu.

Remove assertion checking for possible assumed rank arrays and added an 
explicit error message.


Change if clause to allow the handling of assumed-rank arrays as arrays.

Thank you very much.

Best regards,
José Rui

Fortran: Fix ICE on the handling of assumed-rank procedures 
[PR100024/PR100025]


gcc/fortran/ChangeLog:

* interface.c (argument_rank_mismatch): Remove assertion and add
an explicit error message.
(gfc_get_formal_from_actual_arglist): Allow handling of
assume-rank arrays.

gcc/testsuite/ChangeLog:

* gfortran.dg/PR100024.f90: New test.
* gfortran.dg/PR100025.f90: New test.


diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 60736123550..5868bf23f11 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -2237,8 +2237,11 @@ argument_rank_mismatch (const char *name, locus *where,
 }
   else
 {
-  gcc_assert (rank2 != -1);
-  if (rank1 == 0)
+  if (rank2 == -1)
+	gfc_error_opt (0, "The assumed-rank array actual argument at %L and "
+		   "actual argument at %L are ambiguous, an explicit "
+		   "interface is required.", where, where_formal);
+  else if (rank1 == 0)
 	gfc_error_opt (0, "Rank mismatch between actual argument at %L "
 		   "and actual argument at %L (scalar and rank-%d)",
 		   where, where_formal, rank2);
@@ -5358,7 +5361,7 @@ gfc_get_formal_from_actual_arglist (gfc_symbol *sym,
 	  s->ts.is_iso_c = 0;
 	  s->ts.is_c_interop = 0;
 	  s->attr.flavor = FL_VARIABLE;
-	  if (a->expr->rank > 0)
+	  if (a->expr->rank)
 		{
 		  s->attr.dimension = 1;
 		  s->as = gfc_get_array_spec ();
diff --git a/gcc/testsuite/gfortran.dg/PR100024.f90 b/gcc/testsuite/gfortran.dg/PR100024.f90
new file mode 100644
index 000..fe82ef6da0a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100024.f90
@@ -0,0 +1,37 @@
+! { dg-do compile }
+!
+program foobar
+
+  implicit none
+
+  type :: foo_t
+  end type foo_t
+
+  class(foo_t), pointer :: a
+  type(foo_t),   target :: b
+
+  call bar1(a)
+  call bar2(b)
+  stop
+
+contains
+  
+  subroutine bar1(this)
+class(foo_t), pointer, intent(in) :: this(..)
+
+call foo(this)
+return
+  end subroutine bar1
+
+  subroutine bar2(this)
+type(foo_t), pointer, intent(in) :: this(..)
+
+call foo(this)
+return
+  end subroutine bar2
+  
+end program foobar
+! { dg-error "Explicit interface required for polymorphic argument at \\\(1\\\)" "" { target "*-*-*" } 22 }
+! { dg-excess-errors "" }
+
+
diff --git a/gcc/testsuite/gfortran.dg/PR100025.f90 b/gcc/testsuite/gfortran.dg/PR100025.f90
new file mode 100644
index 000..ef8b58ad94a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100025.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+!
+program foo_p
+
+  implicit none
+
+  class(*), pointer :: a
+  
+  call foo(a)
+  call sub_s(a)
+  stop
+
+contains
+  
+  subroutine bar_s(this)
+class(*), intent(in) :: this(..)
+
+call foo(this)
+return
+  end subroutine bar_s
+  
+end program foo_p
+! { dg-error "Explicit interface required for polymorphic argument at \\\(1\\\)" "" { target "*-*-*" } 10 }
+! { dg-excess-errors "" }
+

Re: [Patch, fortran] PR fortran/100018 - ICE on missing polymorphic argument

2021-04-10 Thread José Rui Faustino de Sousa via Gcc-patches


On 10/04/21 17:37, Tobias Burnus wrote:
And you need an additional single-line summary for git – which should be 
part of the patch submission.




Fortran: Fix ICE due to referencing a NULL pointer [PR100018]

gcc/fortran/ChangeLog:

PR fortran/100018
* resolve.c: Add association check before de-referencing
pointer.


gcc/testsuite/ChangeLog:

PR fortran/100018
* gfortran.dg/PR10018.f90: New test.


Thank you very much.

Best regards,
José Rui

[Patch, fortran] PR fortran/100018 - ICE on missing polymorphic argument

2021-04-10 Thread José Rui Faustino de Sousa via Gcc-patches


Hi all!

Proposed patch to PR100018 - ICE on missing polymorphic argument.

Patch tested only on x86_64-pc-linux-gnu.

Add association check before de-referencing pointer in order to avoid ICE.

Thank you very much.

Best regards,
José Rui


2021-4-10  José Rui Faustino de Sousa  

gcc/fortran/ChangeLog:

PR fortran/100018
* resolve.c: Add association check before de-referencing
pointer.


gcc/testsuite/ChangeLog:

PR fortran/100018
* gfortran.dg/PR10018.f90: New test.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 1c9b0c5cb62..dd4b26680e0 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -11999,6 +11999,7 @@ start:
 	/* Assigning a class object always is a regular assign.  */
 	if (code->expr2->ts.type == BT_CLASS
 		&& code->expr1->ts.type == BT_CLASS
+		&& CLASS_DATA (code->expr2)
 		&& !CLASS_DATA (code->expr2)->attr.dimension
 		&& !(gfc_expr_attr (code->expr1).proc_pointer
 		 && code->expr2->expr_type == EXPR_VARIABLE
diff --git a/gcc/testsuite/gfortran.dg/PR10018.f90 b/gcc/testsuite/gfortran.dg/PR10018.f90
new file mode 100644
index 000..f1cf2676f85
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR10018.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+!
+subroutine foo(that)
+  implicit none
+  class(*),  target, intent(in)  :: this
+  class(*), pointer, intent(out) :: that
+
+  that => this
+  return
+end subroutine foo
+! { dg-error "Symbol at \\\(1\\\) is not a DUMMY variable" "" { target "*-*-*" } 5 }

[Patch, fortran] PR fortran/96870 - Class name on error message

2020-08-31 Thread José Rui Faustino de Sousa via Gcc-patches


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 ? >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] PR fortran/95352 - ICE on select rank with assumed-size selector and lbound intrinsic

2020-08-21 Thread José Rui Faustino de Sousa via Gcc-patches


Hi all!

Proposed patch to PR95352 - ICE on select rank with assumed-size 
selector and lbound intrinsic.


Patch tested only on x86_64-pc-linux-gnu.

Add check for NULL pointer before trying to access structure member, 
patch by Steve Kargl.


Thank you very much.

Best regards,
José Rui


2020-8-21  Steve Kargl 

 PR fortran/95352
 * simplify.c (simplify_bound_dim): Add check for NULL pointer before
 trying to access structure member.

2020-8-21  José Rui Faustino de Sousa  

 PR fortran/95352
 * PR95352.f90: New test.
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 074b50c..a1153dd 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4080,7 +4080,7 @@ simplify_bound_dim (gfc_expr *array, gfc_expr *kind, int d, int upper,
   || (coarray && d == as->rank + as->corank
 	  && (!upper || flag_coarray == GFC_FCOARRAY_SINGLE)))
 {
-  if (as->lower[d-1]->expr_type == EXPR_CONSTANT)
+  if (as->lower[d-1] && as->lower[d-1]->expr_type == EXPR_CONSTANT)
 	{
 	  gfc_free_expr (result);
 	  return gfc_copy_expr (as->lower[d-1]);
diff --git a/gcc/testsuite/gfortran.dg/PR95352.f90 b/gcc/testsuite/gfortran.dg/PR95352.f90
new file mode 100644
index 000..20c8167
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR95352.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+!
+! Test the fix for PR95352
+! 
+  
+module ice6_m
+
+  implicit none
+
+contains
+
+  function ice6_s(a) result(ierr)
+integer, intent(in) :: a(..)
+
+integer :: ierr
+
+integer :: lb
+
+select rank(a)
+rank(*)
+  lb = lbound(a, dim=1)
+  if(lbound(a, dim=1)/=lb) ierr = -1
+end select
+return
+  end function ice6_s
+  
+end module ice6_m

Re: [Patch, fortran, v2] PR fortran/96728 - Fatal Error: Reading module inquiry functions on assumed-rank

2020-08-20 Thread José Rui Faustino de Sousa via Gcc-patches


Hi all!

Exactly the same thing, only actually including the patch this time.

Sorry for the mishap.

Thank you very much.

Best regards,
José Rui


On 20/08/20 19:33, José Rui Faustino de Sousa wrote:

Hi all!

Proposed patch to PR96728 - Fatal Error: Reading module inquiry 
functions on assumed-rank.


Patch tested only on x86_64-pc-linux-gnu.

The rank of the argument to specification functions gets written when 
writing the module file, but, since the value will be negative for 
assumed-rank arrays, the reading the module will fail.


So the patch adds code to handle signed integers.

Thank you very much.

Best regards,
José Rui


2020-8-20  José Rui Faustino de Sousa  

  PR fortran/96728
  * module.c (module_peek_char): Peek ahead function.
  (parse_integer): Add code for parsing signed integers.
  (parse_atom): Add code to handle signed integers.
  (peek_atom): Add code to handle signed integers.

2020-8-20  José Rui Faustino de Sousa  

  PR fortran/96728
  * PR96728.f90: New test.


diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 5114d55..b06cebb 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -1234,6 +1234,13 @@ get_module_locus (module_locus *m)
   m->pos = module_pos;
 }
 
+/* Peek at the next character in the module.  */
+
+static int
+module_peek_char (void)
+{
+  return module_content[module_pos];
+}
 
 /* Get the next character in the module, updating our reckoning of
where we are.  */
@@ -1314,7 +1321,19 @@ parse_string (void)
 static void
 parse_integer (int c)
 {
-  atom_int = c - '0';
+  int sign = 1;
+
+  atom_int = 0;
+  switch (c)
+{
+case ('-'):
+  sign = -1;
+case ('+'):
+  break;
+default:
+  atom_int = c - '0';
+  break;
+}
 
   for (;;)
 {
@@ -1328,6 +1347,7 @@ parse_integer (int c)
   atom_int = 10 * atom_int + c - '0';
 }
 
+  atom_int *= sign; 
 }
 
 
@@ -1401,6 +1421,16 @@ parse_atom (void)
   parse_integer (c);
   return ATOM_INTEGER;
 
+case '+':
+case '-':
+  if (ISDIGIT (module_peek_char ()))
+	{
+	  parse_integer (c);
+	  return ATOM_INTEGER;
+	}
+  else
+	bad_module ("Bad name");
+
 case 'a':
 case 'b':
 case 'c':
@@ -1504,6 +1534,16 @@ peek_atom (void)
   module_unget_char ();
   return ATOM_INTEGER;
 
+case '+':
+case '-':
+  if (ISDIGIT (module_peek_char ()))
+	{
+	  module_unget_char ();
+	  return ATOM_INTEGER;
+	}
+  else
+	bad_module ("Bad name");
+
 case 'a':
 case 'b':
 case 'c':
diff --git a/gcc/testsuite/gfortran.dg/PR96728.f90 b/gcc/testsuite/gfortran.dg/PR96728.f90
new file mode 100644
index 000..4caa3a5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR96728.f90
@@ -0,0 +1,49 @@
+! { dg-do run }
+!
+! Test the fix for PR96728
+!
+
+module cref_m
+
+  implicit none
+
+  private
+
+  public ::   &
+isub_a_m
+  
+contains
+
+  subroutine isub_a_m(a, b)
+integer, intent(in)  :: a(..)
+integer, intent(out) :: b(size(a))
+
+integer :: i
+
+b = [(i, i=1,size(b))]
+return
+  end subroutine isub_a_m
+  
+end module cref_m
+
+program cref_p
+
+  use cref_m, only: &
+isub_a_m
+
+  implicit none
+  
+  integer:: i
+
+  integer, parameter :: n = 3
+  integer, parameter :: p(*) = [(i, i=1,n*n)]
+  
+  integer :: a(n,n)
+  integer :: b(n*n)
+
+  a = reshape(p, shape=[n,n])
+  call isub_a_m(a, b)
+  if (any(b/=p)) stop 1
+  stop
+
+end program cref_p

[Patch, fortran] PR fortran/94110 - Passing an assumed-size to an assumed-shape argument should be rejected

2020-08-20 Thread José Rui Faustino de Sousa via Gcc-patches


Hi all!

Proposed patch to PR94110 - Passing an assumed-size to an assumed-shape 
argument should be rejected.


Patch tested only on x86_64-pc-linux-gnu.

Add code to also check for deferred-shape and assumed-rank pointer 
(allocatable arguments are checked elsewhere) dummy arguments being 
passed an assumed-size array formal argument when raising an error.


Thank you very much.

Best regards,
José Rui


2020-8-20  José Rui Faustino de Sousa  

 PR fortran/94110
 * interface.c (gfc_compare_actual_formal): Add code to also raise the
 actual argument cannot be an assumed-size array error when the dummy
 arguments are deferred-shape or assumed-rank pointer.

2020-8-20  José Rui Faustino de Sousa  

 PR fortran/94110
 * PR94110.f90: New test.
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 7985fc7..020cdd7 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -3303,7 +3303,10 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	  return false;
 	}
 
-  if (f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE
+  if (f->sym->as
+	  && (f->sym->as->type == AS_ASSUMED_SHAPE
+	  || f->sym->as->type == AS_DEFERRED
+	  || (f->sym->as->type == AS_ASSUMED_RANK && f->sym->attr.pointer))
 	  && a->expr->expr_type == EXPR_VARIABLE
 	  && a->expr->symtree->n.sym->as
 	  && a->expr->symtree->n.sym->as->type == AS_ASSUMED_SIZE
diff --git a/gcc/testsuite/gfortran.dg/PR94110.f90 b/gcc/testsuite/gfortran.dg/PR94110.f90
new file mode 100644
index 000..9ec70ec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR94110.f90
@@ -0,0 +1,88 @@
+! { dg-do compile }
+!
+! Test the fix for PR94110
+! 
+  
+program asa_p
+
+  implicit none
+
+  integer, parameter :: n = 7
+
+  integer :: p(n)
+  integer :: s
+
+  p = 1
+  s = sumf_as(p)
+  if (s/=n) stop 1
+  s = sumf_ar(p)
+  if (s/=n) stop 2
+  stop
+
+contains
+
+  function sumf_as(a) result(s)
+integer, target, intent(in) :: a(*)
+
+integer :: s
+
+s = sum_as(a)   ! { dg-error "Actual argument for .a. cannot be an assumed-size array" } 
+s = sum_p_ds(a) ! { dg-error "Actual argument for .a. cannot be an assumed-size array" } 
+s = sum_p_ar(a) ! { dg-error "Actual argument for .a. cannot be an assumed-size array" } 
+return
+  end function sumf_as
+
+  function sumf_ar(a) result(s)
+integer, target, intent(in) :: a(..)
+
+integer :: s
+
+select rank(a)
+rank(*)
+  s = sum_as(a)   ! { dg-error "Actual argument for .a. cannot be an assumed-size array" } 
+  s = sum_p_ds(a) ! { dg-error "Actual argument for .a. cannot be an assumed-size array" } 
+  s = sum_p_ar(a) ! { dg-error "Actual argument for .a. cannot be an assumed-size array" } 
+rank default
+  stop 3
+end select
+return
+  end function sumf_ar
+
+  function sum_as(a) result(s)
+integer, intent(in) :: a(:)
+  
+integer :: s
+
+s = sum(a)
+return
+  end function sum_as
+
+  function sum_p_ds(a) result(s)
+integer, pointer, intent(in) :: a(:)
+  
+integer :: s
+
+s = -1
+if(associated(a))&
+  s = sum(a)
+return
+  end function sum_p_ds
+
+  function sum_p_ar(a) result(s)
+integer, pointer, intent(in) :: a(..)
+  
+integer :: s
+
+s = -1
+select rank(a)
+rank(1)
+  if(associated(a))&
+s = sum(a)
+rank default
+  stop 4
+end select
+return
+  end function sum_p_ar
+
+end program asa_p
+

[Patch, fortran] PR fortran/96728 - Fatal Error: Reading module inquiry functions on assumed-rank

2020-08-20 Thread José Rui Faustino de Sousa via Gcc-patches


Hi all!

Proposed patch to PR96728 - Fatal Error: Reading module inquiry 
functions on assumed-rank.


Patch tested only on x86_64-pc-linux-gnu.

The rank of the argument to specification functions gets written when 
writing the module file, but, since the value will be negative for 
assumed-rank arrays, the reading the module will fail.


So the patch adds code to handle signed integers.

Thank you very much.

Best regards,
José Rui


2020-8-20  José Rui Faustino de Sousa  

 PR fortran/96728
 * module.c (module_peek_char): Peek ahead function.
 (parse_integer): Add code for parsing signed integers.
 (parse_atom): Add code to handle signed integers.
 (peek_atom): Add code to handle signed integers.

2020-8-20  José Rui Faustino de Sousa  

 PR fortran/96728
 * PR96728.f90: New test.

[Patch, fortran] PR fortran/96727 - ICE with character length specified using specification function on assumed-rank array

2020-08-20 Thread José Rui Faustino de Sousa via Gcc-patches


Hi all!

Proposed patch to PR96727 - ICE with character length specified using 
specification function on assumed-rank array.


Patch tested only on x86_64-pc-linux-gnu.

Add missing default error message for the assumed-rank array case.

Thank you very much.

Best regards,
José Rui


2020-8-20  José Rui Faustino de Sousa  

 PR fortran/96727
 * expr.c (gfc_check_init_expr): Add default error message for the
 AS_ASSUMED_RANK case.

2020-8-20  José Rui Faustino de Sousa  

 PR fortran/96727
 * PR96727.f90: New test.
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 6707ca5..aecbe46 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3007,6 +3007,12 @@ gfc_check_init_expr (gfc_expr *e)
 			   e->symtree->n.sym->name, >where);
 		break;
 
+	  case AS_ASSUMED_RANK:
+		gfc_error ("Assumed-rank array %qs at %L is not permitted "
+			   "in an initialization expression",
+			   e->symtree->n.sym->name, >where);
+		break;
+
 	  default:
 		gcc_unreachable();
 	  }
diff --git a/gcc/testsuite/gfortran.dg/PR96727.f90 b/gcc/testsuite/gfortran.dg/PR96727.f90
new file mode 100644
index 000..d45dbb7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR96727.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+!
+! Test the fix for PR96727
+!
+
+program cref_p
+
+  implicit none
+  
+  integer :: i
+
+  integer,  parameter :: n = 3
+  integer,  parameter :: p(*) = [(i, i=1,n*n)]
+  character(len=*), parameter :: q = repeat('a', n*n)
+  
+  integer:: a(n,n)
+  character(len=n*n) :: c
+
+  a = reshape(p, shape=[n,n])
+  call csub(a, c)
+  if (c/=q) stop 1
+  stop
+
+contains
+
+  subroutine csub(a, b)
+integer,intent(in)  :: a(..)
+character(len=size(a)), intent(out) :: b
+
+b = repeat('a', len(b))
+return
+  end subroutine csub
+  
+end program cref_p

[Patch, fortran] PR fortran/96726 - ICE with user defined specification function on assumed-rank array

2020-08-20 Thread José Rui Faustino de Sousa via Gcc-patches


Hi all!

Proposed patch to PR96726 - ICE with user defined specification function 
on assumed-rank array.


Patch tested only on x86_64-pc-linux-gnu.

Obvious fix, replace different operator with less than to avoid infinite 
loop.


Thank you very much.

Best regards,
José Rui


2020-8-20  José Rui Faustino de Sousa  

 PR fortran/96726
 * expr.c (check_references): Change different relational operator to
 less-than operator to avoid infinite loop.

2020-8-20  José Rui Faustino de Sousa  

 PR fortran/96726
 * PR96726.f90: New test.
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 6707ca5..2ef01f0 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3273,7 +3273,7 @@ check_references (gfc_ref* ref, bool (*checker) (gfc_expr*))
   switch (ref->type)
 {
 case REF_ARRAY:
-  for (dim = 0; dim != ref->u.ar.dimen; ++dim)
+  for (dim = 0; dim < ref->u.ar.dimen; ++dim)
 	{
 	  if (!checker (ref->u.ar.start[dim]))
 	return false;
diff --git a/gcc/testsuite/gfortran.dg/PR96726.f90 b/gcc/testsuite/gfortran.dg/PR96726.f90
new file mode 100644
index 000..b0b26b9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR96726.f90
@@ -0,0 +1,72 @@
+! { dg-do run }
+!
+! Test the fix for PR96726
+!
+
+module cref_m
+
+  implicit none
+
+  private
+
+  public ::   &
+sizeish
+  
+contains
+
+  pure function sizeish(a) result(s)
+integer, intent(in) :: a(..)
+
+integer :: s
+
+s = size(a)
+return
+  end function sizeish
+  
+end module cref_m
+
+program cref_p
+
+  use cref_m, only: &
+sizeish
+
+  implicit none
+  
+  integer:: i
+
+  integer, parameter :: n = 3
+  integer, parameter :: p(*) = [(i, i=1,n*n)]
+  
+  integer :: a(n,n)
+  integer :: b(n*n)
+
+  a = reshape(p, shape=[n,n])
+  call isub_a(a, b)
+  if (any(b/=p)) stop 1
+  call isub_b(a, b)
+  if (any(b/=p)) stop 2
+  stop
+
+contains
+
+  subroutine isub_a(a, b)
+integer, intent(in)  :: a(..)
+integer, intent(out) :: b(size(a))
+
+integer :: i
+
+b = [(i, i=1,size(b))]
+return
+  end subroutine isub_a
+  
+  subroutine isub_b(a, b)
+integer, intent(in)  :: a(..)
+integer, intent(out) :: b(sizeish(a))
+
+integer :: i
+
+b = [(i, i=1,sizeish(b))]
+return
+  end subroutine isub_b
+  
+end program cref_p

[Patch, fortran] PR fortran/96724 - Bogus warnings with the repeat intrinsic and the flag -Wconversion-extra

2020-08-20 Thread José Rui Faustino de Sousa via Gcc-patches


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, , 2, 0);
+	}
+  if (tmp->ts.kind != gfc_index_integer_kind)
+	gfc_convert_type_warn (tmp, >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

[Patch, fortran] PR fortran/94022 - Array slices of assumed-size arrays

2020-06-03 Thread José Rui Faustino de Sousa via Gcc-patches


Hi All!

Proposed patch to Bug 94022 - Array slices of assumed-size arrays.

Patch tested only on x86_64-pc-linux-gnu.

Make sure that when passing array sections of assumed-size arrays to 
procedures expecting an assumed-rank array the upper bound of the last 
dimension of the array section does not get improperly reset to -1 to 
mark it has an assumed size array.


Best regards,
José Rui


2020-6-3  José Rui Faustino de Sousa  

 PR fortran/94022
 * trans-expr.c (gfc_conv_procedure_call): In the case of assumed-size
 arrays ensure that the reference is to a full array.

2020-6-3  José Rui Faustino de Sousa  

 PR fortran/94022
 * PR94022.f90: New test.

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 33fc061..2e221b5 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6243,6 +6243,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
  || gfc_expr_attr (e).allocatable)
set_dtype_for_unallocated (, e);
  else if (e->expr_type == EXPR_VARIABLE
+  && e->ref
+  && e->ref->u.ar.type == AR_FULL
   && e->symtree->n.sym->attr.dummy
   && e->symtree->n.sym->as
   && e->symtree->n.sym->as->type == AS_ASSUMED_SIZE)
diff --git a/gcc/testsuite/gfortran.dg/PR94022.f90 
b/gcc/testsuite/gfortran.dg/PR94022.f90
new file mode 100644
index 000..63b7d90
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR94022.f90
@@ -0,0 +1,132 @@
+! { dg-do run }
+!
+! Test the fix for PR94022
+!
+
+function isasa_f(a) result(s)
+  implicit none
+
+  integer, intent(in) :: a(..)
+  
+  logical :: s
+  
+  select rank(a)
+  rank(*)
+s = .true.
+  rank default
+s = .false.
+  end select
+  return
+end function isasa_f
+
+function isasa_c(a) result(s) bind(c)
+  use, intrinsic :: iso_c_binding, only: c_int, c_bool
+
+  implicit none
+
+  integer(kind=c_int), intent(in) :: a(..)
+  
+  logical(kind=c_bool) :: s
+  
+  select rank(a)
+  rank(*)
+s = .true.
+  rank default
+s = .false.
+  end select
+  return
+end function isasa_c
+
+program isasa_p
+
+  implicit none
+
+  interface
+function isasa_f(a) result(s)
+  implicit none
+  integer, intent(in) :: a(..)
+  logical :: s
+end function isasa_f
+function isasa_c(a) result(s) bind(c)
+  use, intrinsic :: iso_c_binding, only: c_int, c_bool
+  implicit none
+  integer(kind=c_int), intent(in) :: a(..)
+  logical(kind=c_bool):: s
+end function isasa_c
+  end interface
+
+  integer, parameter :: sz = 7
+  integer, parameter :: lb = 3
+  integer, parameter :: ub = 9
+  integer, parameter :: ex = ub-lb+1
+
+  integer :: arr(sz,lb:ub)
+
+  arr = 1
+  if (asaf_a(arr, lb+1, ub-1)) stop 1
+  if (asaf_p(arr, lb+1, ub-1)) stop 2
+  if (asaf_a(arr, 2, ex-1))stop 3
+  if (asaf_p(arr, 2, ex-1))stop 4
+  if (asac_a(arr, lb+1, ub-1)) stop 5
+  if (asac_p(arr, lb+1, ub-1)) stop 6
+  if (asac_a(arr, 2, ex-1))stop 7
+  if (asac_p(arr, 2, ex-1))stop 8
+  
+  stop
+
+contains
+
+  function asaf_a(a, lb, ub) result(s)
+integer, intent(in) :: lb
+integer, target, intent(in) :: a(sz,lb:*)
+integer, intent(in) :: ub
+
+logical :: s
+
+s = isasa_f(a(:,lb:ub))
+return
+  end function asaf_a
+
+  function asaf_p(a, lb, ub) result(s)
+integer, intent(in) :: lb
+integer, target, intent(in) :: a(sz,lb:*)
+integer, intent(in) :: ub
+
+logical :: s
+
+integer, pointer :: p(:,:)
+
+p => a(:,lb:ub)
+s = isasa_f(p)
+return
+  end function asaf_p
+
+  function asac_a(a, lb, ub) result(s)
+integer, intent(in) :: lb
+integer, target, intent(in) :: a(sz,lb:*)
+integer, intent(in) :: ub
+
+logical :: s
+
+s = logical(isasa_c(a(:,lb:ub)))
+return
+  end function asac_a
+
+  function asac_p(a, lb, ub) result(s)
+integer, intent(in) :: lb
+integer, target, intent(in) :: a(sz,lb:*)
+integer, intent(in) :: ub
+
+logical :: s
+
+integer, pointer :: p(:,:)
+
+p => a(:,lb:ub)
+s = logical(isasa_c(p))
+return
+  end function asac_p
+
+end program isasa_p
+
+
+

[Patch, fortran] PR fortran/95331 - Unlimited polymorphic arrays have wrong bounds

2020-05-26 Thread José Rui Faustino de Sousa via Gcc-patches


Hi all!

Proposed patch to PR95331 - Unlimited polymorphic arrays have wrong bounds.

Patch tested only on x86_64-pc-linux-gnu.

When iterating over a class array use the bounds provided by the 
transformed descriptor (in sym->backend_decl) instead of the original 
bounds of the array (in the descriptor passed in the class _data) which 
are passed in se->expr.


The patch partially depends on the patch for PR52351 and PR85868, but 
does not seems to break anything by itself.


Not sure if this is the best solution, but at least it identifies the 
problem.


Thank you very much.

Best regards,
José Rui


2020-5-26  José Rui Faustino de Sousa  

 PR fortran/95331
 * trans-array.c (gfc_conv_array_ref): For class array dummy arguments
 use the transformed descriptor in sym->backend_decl instead of the
 original descriptor.

2020-5-26  José Rui Faustino de Sousa  

 PR fortran/95331
 * PR95331.f90: New test.

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 434960c..f44a986 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3672,8 +3672,12 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, 
gfc_expr *expr,
}
 }
 
+  decl = se->expr;
+  if (IS_CLASS_ARRAY (sym) && sym->attr.dummy && ar->as->type != AS_DEFERRED)
+decl = sym->backend_decl;
+
   cst_offset = offset = gfc_index_zero_node;
-  add_to_offset (_offset, , gfc_conv_array_offset (se->expr));
+  add_to_offset (_offset, , gfc_conv_array_offset (decl));
 
   /* Calculate the offsets from all the dimensions.  Make sure to associate
  the final offset so that we form a chain of loop invariant summands.  */
@@ -3694,7 +3698,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, 
gfc_expr *expr,
  indexse.expr = save_expr (indexse.expr);
 
  /* Lower bound.  */
- tmp = gfc_conv_array_lbound (se->expr, n);
+ tmp = gfc_conv_array_lbound (decl, n);
  if (sym->attr.temporary)
{
  gfc_init_se (, se);
@@ -3718,7 +3722,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, 
gfc_expr *expr,
 arrays.  */
  if (n < ar->dimen - 1 || ar->as->type != AS_ASSUMED_SIZE)
{
- tmp = gfc_conv_array_ubound (se->expr, n);
+ tmp = gfc_conv_array_ubound (decl, n);
  if (sym->attr.temporary)
{
  gfc_init_se (, se);
@@ -3741,7 +3745,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, 
gfc_expr *expr,
}
 
   /* Multiply the index by the stride.  */
-  stride = gfc_conv_array_stride (se->expr, n);
+  stride = gfc_conv_array_stride (decl, n);
   tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
 indexse.expr, stride);
 
@@ -3756,6 +3760,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, 
gfc_expr *expr,
   /* A pointer array component can be detected from its field decl. Fix
  the descriptor, mark the resulting variable decl and pass it to
  build_array_ref.  */
+  decl = NULL_TREE;
   if (get_CFI_desc (sym, expr, , ar))
 decl = build_fold_indirect_ref_loc (input_location, decl);
   if (!expr->ts.deferred && !sym->attr.codimension
diff --git a/gcc/testsuite/gfortran.dg/PR95331.f90 
b/gcc/testsuite/gfortran.dg/PR95331.f90
new file mode 100644
index 000..8024e79
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR95331.f90
@@ -0,0 +1,163 @@
+! { dg-do run }
+!
+! PR fortran/95331
+! 
+
+program main_p
+  
+  implicit none
+
+  integer, parameter :: n = 10
+  integer, parameter :: m = 5
+
+  integer, parameter :: b = 3
+  integer, parameter :: t = n+b-1
+  
+  integer, parameter :: l = 4
+  integer, parameter :: u = 7
+  integer, parameter :: s = 3
+  integer, parameter :: e = (u-l)/s+1
+  
+  call test_f()
+  call test_s()
+  call test_p()
+  call test_a()
+  stop
+
+contains
+
+  subroutine test_f()
+integer :: x(n,n)
+integer :: y(b:t)
+integer :: i
+
+x = reshape([(i, i=1,n*n)], [n,n])
+y = x(:,m)
+call sub_s(x(:,m), y, n)
+call sub_s(y, x(:,m), n)
+return
+  end subroutine test_f
+  
+  subroutine test_s()
+integer :: x(n,n)
+integer :: v(e)
+integer :: i
+
+x = reshape([(i, i=1,n*n)], [n,n])
+v = x(l:u:s,m)
+call sub_s(v, v, e)
+call sub_s(x(l:u:s,m), v, e)
+call sub_s(v, x(l:u:s,m), e)
+return
+  end subroutine test_s
+  
+  subroutine test_p()
+integer,  target :: x(n,n)
+integer, pointer :: p(:)
+integer  :: v(e)
+integer  :: i
+
+x = reshape([(i, i=1,n*n)], [n,n])
+v = x(l:u:s,m)
+p => x(:,m)
+call sub_s(p(l:u:s), v, e)
+p => x(l:u:s,m)
+call sub_s(p, v, e)
+p(l:) => x(l:u:s,m)
+call sub_s(p, v, e)
+p(l:l+e-1) => x(l:u:s,m)
+call sub_s(p, v, e)
+allocate(p(n))
+p(:) = x(:,m)
+call sub_s(p(l:u:s), v, e)
+deallocate(p)
+allocate(p(e))
+p(:) = x(l:u:s,m)
+call sub_s(p, v,

[Patch, fortran] PR fortran/52351, 85868 Wrong array section bounds when passing to an intent-in pointer dummy

2020-05-26 Thread José Rui Faustino de Sousa via Gcc-patches


Hi all!

Proposed patch to PRs 52351, 85868 Wrong array section bounds when 
passing to an intent-in pointer dummy.


Patch tested only on x86_64-pc-linux-gnu.

Add code to allow for the creation a new descriptor for array sections 
with the correct one based indexing.


Rework the generated descriptors indexing (hopefully) fixing the wrong 
offsets generated.


Thank you very much.

Best regards,
José Rui


2020-5-25  José Rui Faustino de Sousa  

 PR fortran/85868
 * trans-array.c (gfc_conv_expr_descriptor) Enable the creation of a new
 descriptor with the correct one based indexing for array sections.
 Rework array descriptor indexing offset calculation.

2020-5-25  José Rui Faustino de Sousa  

 PR fortran/85868
 * PR85868A.f90: New test.

2020-5-25  José Rui Faustino de Sousa  

 PR fortran/85868
 * PR85868B.f90: New test.

2020-5-25  José Rui Faustino de Sousa  

 PR fortran/85868
 * coarray_lib_comm_1.f90: Adjust match test for the newly generated
 descriptor.

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 434960c..ef20989 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -7201,7 +7201,6 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
   tree desc;
   stmtblock_t block;
   tree start;
-  tree offset;
   int full;
   bool subref_array_target = false;
   bool deferred_array_component = false;
@@ -7271,7 +7270,11 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
   else if (info->ref->u.ar.type == AR_FULL || se->descriptor_only)
full = 1;
   else if (se->direct_byref)
-   full = 0;
+   full = 0;
+  else if (info->ref->u.ar.dimen == 0 && !info->ref->next)
+   full = 1;
+  else if (info->ref->u.ar.type == AR_SECTION && se->want_pointer)
+   full = 0;
   else
full = gfc_full_array_ref_p (info->ref, NULL);
 
@@ -7508,10 +7511,9 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
   tree from;
   tree to;
   tree base;
-  bool onebased = false, rank_remap;
+  tree offset;
 
   ndim = info->ref ? info->ref->u.ar.dimen : ss->dimen;
-  rank_remap = ss->dimen < ndim;
 
   if (se->want_coarray)
{
@@ -7555,10 +7557,10 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
gfc_add_modify (>pre, expr->ts.u.cl->backend_decl, tmp);
}
 
-  /* If we have an array section or are assigning make sure that
-the lower bound is 1.  References to the full
-array should otherwise keep the original bounds.  */
-  if ((!info->ref || info->ref->u.ar.type != AR_FULL) && !se->want_pointer)
+  /* If we have an array section, are assigning  or passing an array 
+section argument make sure that the lower bound is 1.  References
+to the full array should otherwise keep the original bounds.  */
+  if (!info->ref || info->ref->u.ar.type != AR_FULL)
for (dim = 0; dim < loop.dimen; dim++)
  if (!integer_onep (loop.from[dim]))
{
@@ -7622,8 +7624,6 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
   if (tmp != NULL_TREE)
gfc_conv_descriptor_span_set (, parm, tmp);
 
-  offset = gfc_index_zero_node;
-
   /* The following can be somewhat confusing.  We have two
  descriptors, a new one and the original array.
  {parm, parmtype, dim} refer to the new one.
@@ -7637,22 +7637,17 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
   tmp = gfc_conv_descriptor_dtype (parm);
   gfc_add_modify (, tmp, gfc_get_dtype (parmtype));
 
-  /* Set offset for assignments to pointer only to zero if it is not
- the full array.  */
-  if ((se->direct_byref || se->use_offset)
- && ((info->ref && info->ref->u.ar.type != AR_FULL)
- || (expr->expr_type == EXPR_ARRAY && se->use_offset)))
-   base = gfc_index_zero_node;
-  else if (GFC_ARRAY_TYPE_P (TREE_TYPE (desc)))
-   base = gfc_evaluate_now (gfc_conv_array_offset (desc), );
-  else
-   base = NULL_TREE;
+  /* The 1st element in the section.  */
+  base = gfc_index_zero_node;
+  
+  /* The offset from the 1st element in the section.  */
+  offset = gfc_index_zero_node;
 
   for (n = 0; n < ndim; n++)
{
  stride = gfc_conv_array_stride (desc, n);
 
- /* Work out the offset.  */
+ /* Work out the 1st element in the section.  */
  if (info->ref
  && info->ref->u.ar.dimen_type[n] == DIMEN_ELEMENT)
{
@@ -7672,13 +7667,14 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 start, tmp);
  tmp = fold_build2_loc (input_location, MULT_EXPR, TREE_TYPE (tmp),
 tmp, stride);
- offset = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (tmp),
-   offset, tmp);
+ base = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (tmp),
+

[Patch, fortran] PR fortran/66833,67938,95214 ICE on using assumed rank character array

2020-05-19 Thread José Rui Faustino de Sousa via Gcc-patches


Hi all!

Proposed patch to PRs 66833, 67938 and 95214 ICE(s) on using assumed 
rank character array in different situations.


Patch tested only on x86_64-pc-linux-gnu.

Simple patch only add assumed-rank to the list of possible attributes.

Thank you very much.

Best regards,
José Rui


2020-5-19  José Rui Faustino de Sousa  

 PR fortran/95214
 * trans-expr.c (gfc_maybe_dereference_var): Add assumed-rank to
 character dummy arguments list of possible attributes.

2020-5-19  José Rui Faustino de Sousa  

 PR fortran/95214
 * PR95214.f90: New test.


diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 33fc061..435eaeb 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2613,7 +2613,8 @@ gfc_maybe_dereference_var (gfc_symbol *sym, tree var, 
bool descriptor_only_p,
 {
   /* Dereference character pointer dummy arguments
 or results.  */
-  if ((sym->attr.pointer || sym->attr.allocatable)
+  if ((sym->attr.pointer || sym->attr.allocatable
+  || (sym->as && sym->as->type == AS_ASSUMED_RANK))
  && (sym->attr.dummy
  || sym->attr.function
  || sym->attr.result))
diff --git a/gcc/testsuite/gfortran.dg/PR95214.f90 
b/gcc/testsuite/gfortran.dg/PR95214.f90
new file mode 100644
index 000..682ef63
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR95214.f90
@@ -0,0 +1,84 @@
+! { dg-do run }
+!
+! PR fortran/95214
+!
+
+program chr_p
+
+  implicit none
+
+  integer, parameter :: u = 65
+  
+  integer, parameter :: n = 26
+  
+  character :: c(n)
+  integer   :: i
+
+  c = [(achar(i), i=u,u+n-1)]
+  call chr_s(c, c)
+  call gfc_descriptor_c_char(c)
+  call s1(c)
+  call s1s_a(c)
+  call s1s_b(c)
+  call s2(c)
+  stop
+  
+contains
+
+  subroutine chr_s(a, b)
+character, intent(in) :: a(..)
+character, intent(in) :: b(:)
+
+integer :: i
+
+select rank(a)
+rank(1)
+  do i = 1, size(a)
+if(a(i)/=b(i)) stop 1
+  end do
+rank default
+  stop 1001
+end select
+return
+  end subroutine chr_s
+
+  ! From Bug 66833
+  ! Contributed by Damian Rouson 
+  subroutine gfc_descriptor_c_char(a)
+character a(..)
+if(rank(a)/=1) stop 2001 ! ICE (also for lbound, ubound, and c_loc)
+  end subroutine gfc_descriptor_c_char
+
+
+  ! From Bug 67938
+  ! Contributed by Gerhard Steinmetz 
+  
+  ! example z1.f90
+  subroutine s1(x)
+character(1) :: x(..)
+if(any(lbound(x)/=[1])) stop 3001
+if(any(ubound(x)/=[n])) stop 3002
+  end subroutine s1
+  
+  ! example z1s.f90
+  subroutine s1s_a(x)
+character :: x(..)
+if(size(x)/=n) stop 4001
+  end subroutine s1s_a
+  
+  subroutine s1s_b(x)
+character(77) :: x(..)
+if(size(x)/=n) stop 5001
+  end subroutine s1s_b
+  
+  ! example z2.f90
+  subroutine s2(x)
+character(1) :: x(..)
+if(lbound(x, dim=1)/=1) stop 6001
+if(ubound(x, dim=1)/=n) stop 6002
+if(size(x, dim=1)/=n)   stop 6003
+  end subroutine s2
+  
+end program chr_p
+
+

Re: [Patch v2, fortran] PR fortran/90350 - ubound ICE on assumed size array even though explicit bound is specified

2020-04-22 Thread José Rui Faustino de Sousa via Gcc-patches


Hi Thomas,

On 21/04/20 16:38, Thomas Koenig wrote:

Do you have commit privileges? It not, I can commit it for you.



No i do not. I would be grateful if you could.

Best regards,
José Rui

[Patch v2, fortran] PR fortran/90350 - ubound ICE on assumed size array even though explicit bound is specified

2020-04-21 Thread José Rui Faustino de Sousa via Gcc-patches


Hi again!

Proposed patch to Bug 90350 - ubound ICE on assumed size array even 
though explicit bound is specified


Patch tested only on x86_64-pc-linux-gnu.

Best regards,
José Rui

2020-4-19  José Rui Faustino de Sousa  

 PR fortran/90350
 * simplify.c (simplify_bound): In the case of assumed-size arrays check
 if the reference is to a full array.

2020-4-19  José Rui Faustino de Sousa  

 PR fortran/90350
 * PR90350.f90: New test.

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index c7a4f77..eb8b2af 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4157,6 +4157,7 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, gfc_expr 
*kind, int upper)
 {
   gfc_ref *ref;
   gfc_array_spec *as;
+  ar_type type = AR_UNKNOWN;
   int d;
 
   if (array->ts.type == BT_CLASS)
@@ -4180,6 +4181,7 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, gfc_expr 
*kind, int upper)
   switch (ref->type)
{
case REF_ARRAY:
+ type = ref->u.ar.type;
  switch (ref->u.ar.type)
{
case AR_ELEMENT:
@@ -4233,7 +4235,7 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, gfc_expr 
*kind, int upper)
   int k;
 
   /* UBOUND(ARRAY) is not valid for an assumed-size array.  */
-  if (upper && as && as->type == AS_ASSUMED_SIZE)
+  if (upper && type == AR_FULL && as && as->type == AS_ASSUMED_SIZE)
{
  /* An error message will be emitted in
 check_assumed_size_reference (resolve.c).  */
diff --git a/gcc/testsuite/gfortran.dg/PR90350.f90 
b/gcc/testsuite/gfortran.dg/PR90350.f90
new file mode 100644
index 000..2e2cf10
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR90350.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+!
+! Test the fix for PR90350
+!
+! Contributed by  
+!
+
+program artificial
+implicit none
+integer :: arr(-10:10)
+   call asub(arr,size(arr))
+end program artificial
+subroutine asub(arr,n)
+integer,intent(in) :: arr(*)
+integer,intent(in) :: n
+   write(*,*)'UPPER=',ubound(arr(:n))
+   write(*,*)'LOWER=',lbound(arr(:n))
+   write(*,*)'SIZE=',size(arr(:n))
+end subroutine asub

Re: [Patch, fortran] PR fortran/90350 - ubound ICE on assumed size array even though explicit bound is specified

2020-04-19 Thread José Rui Faustino de Sousa via Gcc-patches


Hi Thomas!

> ? In other words, maybe a check on the upper bound
> of the last dimension would be better?
>

You mean enforcing:

C928 (R921) The second subscript shall not be omitted from a 
subscript-triplet in the last dimension of an assumed-size array.


right?

If I have correctly understood the way things are done this is a more 
general test which is already done at resolve.c around line 4690.


One could just duplicate the test to be extra safe.

> A question: Do you have a copyright assignment yet?
>

Yes, I have already done that.

Best regards,
José Rui

[Patch, fortran] PR fortran/90350 - ubound ICE on assumed size array even though explicit bound is specified

2020-04-19 Thread José Rui Faustino de Sousa via Gcc-patches


Hi all!

Proposed patch to Bug 90350 - ubound ICE on assumed size array even 
though explicit bound is specified


Patch tested only on x86_64-pc-linux-gnu.

Bumped into the same problem.

Probably a better fix would be to add an extra step to the reference 
chain reflecting that array-section are explicit-shape arrays not 
whatever that was sectioned. But, although this pattern of problem shows 
up in the code in other places, it may be more trouble than it is worth...


Thank you very much.

Best regards,
José Rui

2020-4-19  José Rui Faustino de Sousa  

 PR fortran/90350
 * simplify.c (simplify_bound): In the case of assumed-size arrays check
 if the reference is to a full array.

2020-4-19  José Rui Faustino de Sousa  

 PR fortran/90350
 * PR90350.f90: New test.


diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index d5703e3..4818368 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4157,6 +4157,7 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, 
gfc_expr *kind, int upper)

 {
   gfc_ref *ref;
   gfc_array_spec *as;
+  ar_type type = AR_UNKNOWN;
   int d;

   if (array->ts.type == BT_CLASS)
@@ -4180,6 +4181,7 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, 
gfc_expr *kind, int upper)

   switch (ref->type)
{
case REF_ARRAY:
+ type = ref->u.ar.type;
  switch (ref->u.ar.type)
{
case AR_ELEMENT:
@@ -4233,7 +4235,10 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, 
gfc_expr *kind, int upper)

   int k;

   /* UBOUND(ARRAY) is not valid for an assumed-size array.  */
-  if (upper && as && as->type == AS_ASSUMED_SIZE)
+  if (upper
+ && type == AR_FULL
+ && as
+ && as->type == AS_ASSUMED_SIZE)
{
  /* An error message will be emitted in
 check_assumed_size_reference (resolve.c).  */
diff --git a/gcc/testsuite/gfortran.dg/PR90350.f90 
b/gcc/testsuite/gfortran.dg/PR90350.f90

new file mode 100644
index 000..2e2cf10
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR90350.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+!
+! Test the fix for PR90350
+!
+! Contributed by  
+!
+
+program artificial
+implicit none
+integer :: arr(-10:10)
+   call asub(arr,size(arr))
+end program artificial
+subroutine asub(arr,n)
+integer,intent(in) :: arr(*)
+integer,intent(in) :: n
+   write(*,*)'UPPER=',ubound(arr(:n))
+   write(*,*)'LOWER=',lbound(arr(:n))
+   write(*,*)'SIZE=',size(arr(:n))
+end subroutine asub

[Patch, fortran] PR fortran/94327 and PR fortran/94331 Bind(C) problems

2020-03-25 Thread José Rui Faustino de Sousa via Gcc-patches


Hi all!

Proposed patch to:

Bug 94327 - Bind(c) argument attributes are incorrectly set

and to:

Bug 94331 - Bind(C) corrupts array descriptors

Patch tested only on x86_64-pc-linux-gnu.

Sorry for the double patch but applying them separately would break things.

Fixing 94327 is simple, just fix the if clause assigning cfi_attribute 
so that it will always have the attribute of the dummy argument not, 
sometimes, the attribute of the effective argument.


The array descriptor corruption is caused by the overwriting of the GFC 
array descriptor, on exit, with the internal bounds of the CFI 
descriptor which will be different, if the attribute is CFI_attribute_other.


This conversion is AFAICT unnecessary if the dummy argument has the 
CFI_attribute_other or the value attributes set or if the intent is in.


Any other case I might have forgotten?

The conversion procedures where adjusted so that on output, for 
attribute CFI_attribute_other, the lower bound is set to 1 not 0 and on 
input so that arrays are only marked as assumed-size if the attribute is 
also CFI_attribute_other.


The ISO_Fortran_binding_1.f90 test c_establish procedure is somewhat 
problematic, passing a dissociated pointer was clearly undefined 
behavior, and I believe that the way CFI_establish is used and the 
allocations are done is not kosher either.


Some of the tests are disabled because of PR93957 and PR94289, I have 
previously posted a patch to PR93957.


Thank you very much.

Best regards,
José Rui


2020-3-25  José Rui Faustino de Sousa  

 PR fortran/94331
 * trans-decl.c (convert_CFI_desc): Only overwrite the array descriptor
 if the dummy argument has the pointer or allocatable attribute set and
 not if it has the value attribute set or if it is intent in.

2020-3-25  José Rui Faustino de Sousa  

 PR fortran/94327
 * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Change if clause in
 order to set the dummy argiment's attribute to the correct value and
 remove obsolete comment.

2020-3-25  José Rui Faustino de Sousa  

 PR fortran/94331
 * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Only overwrite the
 array descriptor if the dummy argument's attribute is
 CFI_attribute_other and if it has not the value attribute set or if it
 is intent in.

2020-3-25  José Rui Faustino de Sousa  

 PR fortran/94331
 * ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Set the array
 descriptor lower bound to 1 if the attribute is CFI_attribute_other.

2020-3-25  José Rui Faustino de Sousa  

 PR fortran/94331
 * ISO_Fortran_binding.c (gfc_desc_to_cfi_desc): Only mark the CFI
 descriptor as assumed-size if the attribute is CFI_attribute_other.

2020-3-25  José Rui Faustino de Sousa  

 PR fortran/94327
 * ISO_Fortran_binding_1.f90: Add pointer attribute to c_establish
 argument in the interface.

2020-3-25  José Rui Faustino de Sousa  

 PR fortran/94331
 * bind_c_array_params_2.f90: Remove test for code that is no longer
 emitted.

2020-3-25  José Rui Faustino de Sousa  

 PR fortran/94327
 * PR94327.f90: New test.
 * PR94327.c: Additional source.

2020-3-25  José Rui Faustino de Sousa  

 PR fortran/94331
 * PR94331.f90: New test.
 * PR94331.c: Additional source.


diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index e91a279..88e762a 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -4472,19 +4472,26 @@ convert_CFI_desc (gfc_wrapped_block * block, 
gfc_symbol *sym)


   /* Convert the gfc descriptor back to the CFI type before going
 out of scope, if the CFI type was present at entry.  */
-  gfc_init_block (_block);
-  gfc_init_block ();
+  outgoing = NULL_TREE;
+  if ((sym->attr.pointer
+  || sym->attr.allocatable)
+ && !sym->attr.value
+ && sym->attr.intent != INTENT_IN)
+   {
+ gfc_init_block (_block);
+ gfc_init_block ();

-  tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr);
-  outgoing = build_call_expr_loc (input_location,
-   gfor_fndecl_gfc_to_cfi, 2, tmp, gfc_desc_ptr);
-  gfc_add_expr_to_block (, outgoing);
+ tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr);
+ outgoing = build_call_expr_loc (input_location,
+ gfor_fndecl_gfc_to_cfi, 2, tmp, 
gfc_desc_ptr);
+ gfc_add_expr_to_block (, outgoing);

-  outgoing = build3_v (COND_EXPR, present,
-  gfc_finish_block (),
-  build_empty_stmt (input_location));
-  gfc_add_expr_to_block (_block, outgoing);
-  outgoing = gfc_finish_block (_block);
+ outgoing = build3_v (COND_EXPR, present,
+  gfc_finish_block (),
+  build_empty_stmt (input_location));
+ gfc_add_expr_to_block (_block, outgoing);
+ outgoing = gfc_finish_block (_block);
+   }

   /* Add the lot to the procedure init and finally blocks.  */

50 matches

Mail list logo