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

2021-04-15 Thread Tobias Burnus

Hi José,

first, I think you did not yet commit the approved patch for PR100018,
did you?

On 11.04.21 02:34, José Rui Faustino de Sousa via Fortran wrote:

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.


LGTM – however, I think it would be useful to also test polymorphic
components
– and to check whether the result comes out right, especially as you
already have a dg-do run test.

Hence, how about replacing that testcase by the extended attached testcase?

Tobias


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.


-
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München 
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank 
Thürauf
! { dg-do run }
!

program foo_p

  implicit none

  integer, parameter :: n = 11
  integer, parameter :: foo_size = storage_size(n)*4
  integer, parameter :: bar_size = storage_size(n)*(4+8)
  
  type :: foo_t
integer :: arr1(4)
  end type foo_t

  type, extends(foo_t) :: bar_t
integer :: arr2(8)
  end type bar_t

  type box_t
class(foo_t), allocatable :: x, y(:)
  end type box_t

  class(*), pointer :: apu(:)
  class(foo_t), pointer :: apf(:)
  class(bar_t), pointer :: apb(:)
  type(foo_t),  target :: atf(n)
  type(bar_t),  target :: atb(n)
  type(box_t), target :: aa, bb

  integer :: m
  
  apu => atb
  m = storage_size(apu)
  if (m /= bar_size) stop
  apu => atf
  m = storage_size(apu)
  if (m /= foo_size) stop
  apf => atb
  m = storage_size(apf)
  if (m /= bar_size) stop
  apf => atf
  m = storage_size(apf)
  if (m /= foo_size) stop
  apb => atb
  m = storage_size(apb)
  if (m /= bar_size) stop

  allocate(foo_t :: aa%x, aa%y(1))
  allocate(bar_t :: bb%x, bb%y(1))
  if (storage_size(aa%x) /= foo_size) stop
  if (storage_size(aa%y) /= foo_size) stop
  if (storage_size(bb%x) /= bar_size) stop
  if (storage_size(bb%y) /= bar_size) stop

  apu => bb%y
  m = storage_size(apu)
  if (m /= bar_size) stop
  apu => aa%y
  m = storage_size(apu)
  if (m /= foo_size) stop
  apf => bb%y
  m = storage_size(apf)
  if (m /= bar_size) stop
  apf => aa%y
  m = storage_size(apf)
  if (m /= foo_size) stop

end program foo_p


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

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

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 (&init, tmp);
+}
   gfc_restore_backend_locus (&loc);
   gfc_init_block (&cleanup);
 
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


Re: [Patch, fortran] 99307 - FAIL: gfortran.dg/class_assign_4.f90 execution test

2021-04-15 Thread Paul Richard Thomas via Fortran
Pushed to master in commit 9a0e09f3dd5339bb18cc47317f2298d9157ced29

Thanks

Paul


On Wed, 14 Apr 2021 at 14:51, Tobias Burnus  wrote:

> On 11.04.21 09:05, Paul Richard Thomas wrote:
> > Tobias noticed a major technical fault with the resubmission below: I
> > forgot to attach the patch :-(
>
> LGTM. Plus as remarked in the first review: 'trans-expr_c' typo needs to
> be fixed (ChangeLog).
>
> Tobias
>
> >
> > Please find it attached this time.
> >
> > Paul
> >
> > On Tue, 6 Apr 2021 at 18:08, Paul Richard Thomas
> > mailto:paul.richard.tho...@gmail.com>>
> > wrote:
> >
> > Hi Tobias,
> >
> > I believe that the attached fixes the problems that you found with
> > gfc_find_and_cut_at_last_class_ref.
> >
> > I will test:
> >type1%type%array_class2 → NULL is returned  (why?)
> >class1%type%array_class2 → ts = class1 but array2_class is used
> > later on (ups!)
> >class1%...%scalar_class2 → ts = class1 but scalar_class2 is used
> >
> > The ChangeLogs remain the same, apart from the date.
> >
> > Regtests OK on FC33/x86_64.
> >
> > Paul
> >
> >
> > On Mon, 29 Mar 2021 at 14:58, Tobias Burnus
> > mailto:tob...@codesourcery.com>> wrote:
> >
> > Hi all,
> >
> > as preremark I want to note that the testcase class_assign_4.f90
> > was added for PR83118/PR96012 (fixes problems in handling
> > class objects, Dec 18, 2020)
> > and got revised for PR99124 (class defined operators, Feb 23,
> > 2021).
> > Both patches were then also applied to GCC 9 and 10.
> >
> > On 26.03.21 17:30, Paul Richard Thomas via Gcc-patches wrote:
> > > This patch comes in two versions: submit.diff with
> > Change.Logs or
> > > submit2.diff with Change2.Logs.
> > > The first fixes the problem by changing array temporaries
> > from class
> > > expressions into class temporaries. This permits the use of
> > > gfc_get_class_from_expr to obtain the vptr for these
> > temporaries and all
> > > the good things that come with that when handling dynamic
> > types. The second
> > > part of the fix is to use the array element length from the
> > class
> > > descriptor, when reallocating on assignment. This is needed
> > because the
> > > vptr is being set too early. I will set about trying to
> > track down why this
> > > is happening and fix it after release.
> > >
> > > The second version does the same as the first but puts in
> > place a load of
> > > tidying up that is permitted by the fix to class array
> > temporaries.
> >
> > > I couldn't readily see how to prepare a testcase - ideas?
> > > Both regtest on FC33/x86_64. The first was tested by
> > Dominique (see the
> > > PR). OK for master?
> >
> > Typo – underscore-'c' should be a dot-'c' – both changelog files
> >
> > >   * trans-expr_c (gfc_trans_scalar_assign): Make use of
> > pre and
> >
> > I think the second longer version is nicer in general, but at
> > least for
> > GCC 9/GCC10 the first version is simpler and, hence, less
> > error prone.
> >
> > As you only ask about mainline, I would prefer the second one.
> >
> > However, I am not happy about gfc_find_and_cut_at_last_class_ref:
> >
> > > + of refs following. If ts is non-null the cut is at the
> > class entity
> > > + or component that is followed by an array reference, which
> > is not +
> > > an element. */ ... + + if (ts) + { + if (e->symtree + &&
> > > e->symtree->n.sym->ts.type == BT_CLASS) + *ts =
> > > &e->symtree->n.sym->ts; + else + *ts = NULL; + } + for (ref
> > = e->ref;
> > > ref; ref = ref->next) { + if (ts && ref->type ==
> > REF_COMPONENT + &&
> > > ref->u.c.component->ts.type == BT_CLASS + && ref->next &&
> > > ref->next->type == REF_COMPONENT + && strcmp
> > > (ref->next->u.c.component->name, "_data") == 0 + &&
> > ref->next->next +
> > > && ref->next->next->type == REF_ARRAY + &&
> > ref->next->next->u.ar.type
> > > != AR_ELEMENT) + { + *ts = &ref->u.c.component->ts; +
> > class_ref = ref;
> > > + break; + } + + if (ts && *ts == NULL) + return NULL; +
> > Namely, if there is:
> >type1%array_class2 → array_class2 is used for 'ts' and
> > later (ok)
> >type1%type%array_class2 → NULL is returned  (why?)
> >class1%type%array_class2 → ts = class1 but array2_class is
> > used later on (ups!)
> >class1%...%scalar_class2 → ts = class1 but scalar_class2 is
> > used
> > etc.
> >
> > Thus this either needs to be cleaned up (separate 'ref' loop for
> > ts != NULL) – inclu

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

2021-04-15 Thread Tobias Burnus

On 15.04.21 13:56, José Rui Faustino de Sousa via Gcc-patches wrote:


Proposed patch to:
PR100094 - Undefined pointers have incorrect rank when using optimization
Patch tested only on x86_64-pc-linux-gnu.


LGTM - thanks!

Tobias


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.


-
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München 
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank 
Thürauf


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 Fortran

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 (&loc);
+  gfc_set_backend_locus (&sym->declared_at);
+  gfc_init_block (&init);
+
+  rank = CLASS_DATA (sym)->as ? (CLASS_DATA (sym)->as->rank) : (0);
+  gcc_assert (rank>=0);
+  tmp = gfc_conv_descriptor_dtype (descriptor);
+  etype = gfc_get_element_type (type);
+  tmp = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (tmp), tmp,
+			 gfc_get_dtype_rank_type (rank, etype));
+  gfc_add_expr_to_block (&init, tmp);
+
+  gfc_add_init_cleanup (block, gfc_finish_block (&init), NULL_TREE);
+  gfc_restore_backend_locus (&loc);
+}
+
+
 /* NULLIFY an allocatable/pointer array on function entry, free it on exit.
Do likewise, recursively if necessary, with the allocatable components of
derived types.  This function is also called for assumed-rank arrays, which
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 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 f

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

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

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] PR fortran/63797 - Bogus ambiguous reference to 'sqrt'

2021-04-15 Thread Harald Anlauf via Fortran
Hello everybody,

we currently write the interface for intrinsic procedures to module
files although that should not be necessary.  (F2018:15.4.2.1 actually
states that interfaces e.g. of intrinsic procedures are 'explicit'.)
This lead to bogus errors due to an apparently bogus ambiguity.
A simple solution is to just avoid writing that (redundant) information
to the module file.

Regtested on x86_64-pc-linux-gnu.  OK for (current) mainline?
Or rather wait after 11 release?

Thanks,
Harald


PR fortran/63797 - Bogus ambiguous reference to 'sqrt'

The interface of an intrinsic procedure is automatically explicit.
Do not write it to the module file.

gcc/fortran/ChangeLog:

* module.c (write_symtree): Do not write interface of intrinsic
procedure to module file.

gcc/testsuite/ChangeLog:

* gfortran.dg/pr63797.f90: New test.

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 4db0a3ac76d..b4b7b437f86 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -6218,6 +6218,9 @@ write_symtree (gfc_symtree *st)
   if (check_unique_name (st->name))
 return;

+  if (strcmp (sym->module, "(intrinsic)") == 0)
+return;
+
   p = find_pointer (sym);
   if (p == NULL)
 gfc_internal_error ("write_symtree(): Symbol not written");
diff --git a/gcc/testsuite/gfortran.dg/pr63797.f90 b/gcc/testsuite/gfortran.dg/pr63797.f90
new file mode 100644
index 000..1131e8167b1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr63797.f90
@@ -0,0 +1,60 @@
+! { dg-do compile }
+! PR63797 - Bogus ambiguous reference to 'sqrt'
+
+module mod1
+  implicit none
+  real, parameter :: z = sqrt (0.0)
+  real:: w = sqrt (1.0)
+  interface
+ pure real function sqrt_ifc (x)
+   real, intent(in) :: x
+ end function sqrt_ifc
+  end interface
+contains
+  pure function myroot () result (f)
+procedure(sqrt_ifc), pointer :: f
+intrinsic :: sqrt
+f => sqrt
+  end function myroot
+end module mod1
+
+module mod2
+  implicit none
+  type t
+ real :: a = 0.
+  end type
+  interface sqrt
+ module procedure sqrt
+  end interface
+contains
+  elemental function sqrt (a)
+type(t), intent(in) :: a
+type(t) :: sqrt
+sqrt% a = a% a
+  end function sqrt
+end module mod2
+
+module mod3
+  implicit none
+  abstract interface
+ function real_func (x)
+   real  :: real_func
+   real, intent (in) :: x
+ end function real_func
+  end interface
+  intrinsic :: sqrt
+  procedure(real_func), pointer :: real_root => sqrt
+end module mod3
+
+program test
+  use mod1
+  use mod2
+  use mod3
+  implicit none
+  type(t) :: x, y
+  procedure(sqrt_ifc), pointer :: root
+  root => myroot ()
+  y= sqrt (x)
+  y% a = sqrt (x% a) + z - w + root (x% a)
+  y% a = real_root (x% a)
+end program test