RE: GDB/Fortran: Support for Assumed Rank Zero.

["Potharla, Rupesh via Gdb-patches" <gdb-patches@sourceware.org>]

[-- Attachment #1: Type: text/plain, Size: 7303 bytes --]

[AMD Official Use Only]

Thanks, Andrew,

Made suggested code changes and attached the updated patch. Requesting to review the code changes.  


Regards,
Rupesh P

>> From 5357e50f3083d6fcbdcab4ca8932ae123d32773b Mon Sep 17 00:00:00
>2001
>> From: rupothar <rupesh.potharla@amd.com>
>> Date: Fri, 8 Apr 2022 16:05:41 +0530
>> Subject: [PATCH] gdb/fortran: Support for assumed rank zero
>>
>> If a variable is passed to function in FORTRAN as an argument the
>> variable is treated as an array with rank zero.  GDB currently does
>> not support the case for assumed rank 0.  This patch provides support
>> for assumed rank 0 and updates the testcase as well.
>>
>> Without patch:
>> Breakpoint 1, arank::sub1 (a=<error reading variable:
>>   failed to resolve dynamic array rank>) at assumedrank.f90:11
>> 11       PRINT *, RANK(a)
>> (gdb) p a
>> failed to resolve dynamic array rank
>> (gdb) p rank(a)
>> failed to resolve dynamic array rank
>>
>> With patch:
>> Breakpoint 1, arank::sub1 (a=0) at assumedrank.f90:11
>> 11       PRINT *, RANK(a)
>> (gdb) p a
>> $1 = 0
>> (gdb) p rank(a)
>> $2 = 0
>> ---
>>  gdb/gdbtypes.c                            | 11 +++++++----
>>  gdb/gdbtypes.h                            |  1 -
>>  gdb/testsuite/gdb.fortran/assumedrank.exp |  7 +++++++
>>  gdb/testsuite/gdb.fortran/assumedrank.f90 |  3 +++
>>  4 files changed, 17 insertions(+), 5 deletions(-)
>>
>> diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c index
>> 49ecb199b07..afedd1f61b7 100644
>> --- a/gdb/gdbtypes.c
>> +++ b/gdb/gdbtypes.c
>> @@ -2398,10 +2398,13 @@ resolve_dynamic_array_or_string (struct type
>> *type,
>>
>>        if (rank == 0)
>>       {
>> -       /* The dynamic property list juggling below was from the original
>> -          patch.  I don't understand what this is all about, so I've
>> -          commented it out for now and added the following error.  */
>> -       error (_("failed to resolve dynamic array rank"));
>> +       /* Rank is zero, if a variable is passed as an argument to a
>> +          function.  GDB considers the variable as an array so discard
>> +          the array type and return the target type which is of variable.  */
>> +       type->main_type->target_type->main_type->dyn_prop_list
>> +         = type->main_type->dyn_prop_list;
>> +       type = TYPE_TARGET_TYPE (type);
>> +       return type;
>
>I don't think this is correct, but I'm not completely sure what the correct thing
>to do is.
>
>TYPE here was created with a call to copy_type.  After this call TYPE is a copy
>of the original dynamic type, but I believe that this is only a shallow copy (see
>copy_type in gdbtypes.c), so target_type will point at the same type object as
>the original dynamic type.
>
>When you copy the dyn_prop_list like you do above you are modifying the
>original target_type object.  The next time this function is called we'll end up
>modifying the same target_type object again.  I don't think this is correct.
>
>Also I don't think we are supposed to be creating multiple pointers to the
>same dyn_prop_list object like you're doing, I think you need to call
>copy_dynamic_prop_list.
>
>That said, I'm a little concerned that by just copying over the properties like
>this you're discarding any dynamic properties that might already exist on the
>target_type - though I'm not sure if it's possible to create a target_type that
>actually has any dynamic properties of its own.... maybe that's a problem we
>can leave until such a case crops up?
>I do suspect it might only be the data location that you really care about, so
>maybe we should only be copying that property?

Yes, the change was made only for data location for printing the value.  

>Anyway, if we don't worry about dynamic properties that might already exist
>on target_type, then the following code seems to work, but I've only done a
>quick test:

So far, I have not seen dynamic properties for array elements for rank0. I picked up the below code changes and updated the patch.   

>      if (rank == 0)
>        {
>          /* Rank is zero if a variable is passed as an argument to a
>             function.  In this case the resolved type should not be an
>             array, but should instead be that of an array element.  */
>          struct type *dynamic_array_type = type;
>          type = copy_type (TYPE_TARGET_TYPE (dynamic_array_type));
>          struct dynamic_prop_list *prop_list
>            = TYPE_MAIN_TYPE (dynamic_array_type)->dyn_prop_list;
>          if (prop_list != nullptr)
>            {
>              struct obstack *obstack
>                = &type->objfile_owner ()->objfile_obstack;
>              TYPE_MAIN_TYPE (type)->dyn_prop_list
>                = copy_dynamic_prop_list (obstack, prop_list);
>            }
>          return type;
>        }
>
>You'll notice I also changed the comment within this block as I found the
>original comment hard to understand.

Apologies for the hard comment, Thanks for the correction. 

>What do you think?
>
>Thanks,
>Andrew
>
>
>>       }
>>        else if (type->code () == TYPE_CODE_STRING && rank != 1)
>>       {
>> diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h index
>> 769328cc9cd..7437e1db8ab 100644
>> --- a/gdb/gdbtypes.h
>> +++ b/gdb/gdbtypes.h
>> @@ -2092,7 +2092,6 @@ extern void allocate_gnat_aux_type (struct type
>> *);  #define TYPE_REFERENCE_TYPE(thistype) (thistype)->reference_type
>> #define TYPE_RVALUE_REFERENCE_TYPE(thistype)
>> (thistype)->rvalue_reference_type  #define TYPE_CHAIN(thistype)
>> (thistype)->chain -#define TYPE_DYN_PROP(thistype)
>> TYPE_MAIN_TYPE(thistype)->dyn_prop_list
>>  /* * Note that if thistype is a TYPEDEF type, you have to call check_typedef.
>>     But check_typedef does set the TYPE_LENGTH of the TYPEDEF type,
>>     so you only have to call check_typedef once.  Since allocate_value
>> diff --git a/gdb/testsuite/gdb.fortran/assumedrank.exp
>> b/gdb/testsuite/gdb.fortran/assumedrank.exp
>> index 69cd168125f..bd058e01e89 100644
>> --- a/gdb/testsuite/gdb.fortran/assumedrank.exp
>> +++ b/gdb/testsuite/gdb.fortran/assumedrank.exp
>> @@ -58,6 +58,13 @@ while { $test_count < 500 } {
>>           }
>>       }
>>
>> +     # XFAIL rank 0 for flang.
>> +     if {$test_count == 1 && [test_compiler_info {clang-*}]} {
>> +        setup_xfail "*-*-*"
>> +        fail "compiler does not support rank 0"
>> +        continue
>> +     }
>> +
>>       if ($found_final_breakpoint) {
>>           break
>>       }
>> diff --git a/gdb/testsuite/gdb.fortran/assumedrank.f90
>> b/gdb/testsuite/gdb.fortran/assumedrank.f90
>> index 7f077c3f014..7f7cf2c1f3e 100644
>> --- a/gdb/testsuite/gdb.fortran/assumedrank.f90
>> +++ b/gdb/testsuite/gdb.fortran/assumedrank.f90
>> @@ -19,16 +19,19 @@
>>
>>  PROGRAM  arank
>>
>> +  REAL :: array0
>>    REAL :: array1(10)
>>    REAL :: array2(1, 2)
>>    REAL :: array3(3, 4, 5)
>>    REAL :: array4(4, 5, 6, 7)
>>
>> +  array0 = 0
>>    array1 = 1.0
>>    array2 = 2.0
>>    array3 = 3.0
>>    array4 = 4.0
>>
>> +  call test_rank (array0)
>>    call test_rank (array1)
>>    call test_rank (array2)
>>    call test_rank (array3)
>> --
>> 2.17.1

[-- Attachment #2: 0001-gdb-fortran-Support-for-assumed-rank-zero.patch --]
[-- Type: application/octet-stream, Size: 4849 bytes --]

From fbfa2f4c26eeef7547603aafafb9525d66d1b172 Mon Sep 17 00:00:00 2001
From: rupothar <rupesh.potharla@amd.com>
Date: Fri, 8 Apr 2022 16:05:41 +0530
Subject: [PATCH] gdb/fortran: Support for assumed rank zero

If a variable is passed to function in FORTRAN as an argument the
variable is treated as an array with rank zero.  GDB currently does
not support the case for assumed rank 0.  This patch provides support
for assumed rank 0 and updates the testcase as well.

Without patch:
Breakpoint 1, arank::sub1 (a=<error reading variable:
  failed to resolve dynamic array rank>) at assumedrank.f90:11
11       PRINT *, RANK(a)
(gdb) p a
failed to resolve dynamic array rank
(gdb) p rank(a)
failed to resolve dynamic array rank

With patch:
Breakpoint 1, arank::sub1 (a=0) at assumedrank.f90:11
11       PRINT *, RANK(a)
(gdb) p a
$1 = 0
(gdb) p rank(a)
$2 = 0
---
 gdb/gdbtypes.c                            | 21 ++++++++++++++++-----
 gdb/gdbtypes.h                            |  4 +++-
 gdb/testsuite/gdb.fortran/assumedrank.exp |  6 ++++++
 gdb/testsuite/gdb.fortran/assumedrank.f90 |  3 +++
 4 files changed, 28 insertions(+), 6 deletions(-)

diff --git a/gdb/gdbtypes.c b/gdb/gdbtypes.c
index 49ecb199b07..47cf442a2d5 100644
--- a/gdb/gdbtypes.c
+++ b/gdb/gdbtypes.c
@@ -2398,10 +2398,21 @@ resolve_dynamic_array_or_string (struct type *type,
 
       if (rank == 0)
 	{
-	  /* The dynamic property list juggling below was from the original
-	     patch.  I don't understand what this is all about, so I've
-	     commented it out for now and added the following error.  */
-	  error (_("failed to resolve dynamic array rank"));
+	  /* Rank is zero, if a variable is passed as an argument to a
+	     function.  In this case the resolved type should not be an
+	     array, but should instead be that of an array element.  */
+	  struct type *dynamic_array_type = type;
+	  type = copy_type (TYPE_TARGET_TYPE (dynamic_array_type));
+	  struct dynamic_prop_list *prop_list
+	    = TYPE_MAIN_TYPE (dynamic_array_type)->dyn_prop_list;
+	  if (prop_list != nullptr)
+	    {
+	      struct obstack *obstack
+		= &type->objfile_owner ()->objfile_obstack;
+	      TYPE_MAIN_TYPE (type)->dyn_prop_list
+		= copy_dynamic_prop_list (obstack, prop_list);
+	    }
+	  return type;
 	}
       else if (type->code () == TYPE_CODE_STRING && rank != 1)
 	{
@@ -5589,7 +5600,7 @@ create_copied_types_hash (struct objfile *objfile)
 
 /* Recursively copy (deep copy) a dynamic attribute list of a type.  */
 
-static struct dynamic_prop_list *
+struct dynamic_prop_list *
 copy_dynamic_prop_list (struct obstack *objfile_obstack,
 			struct dynamic_prop_list *list)
 {
diff --git a/gdb/gdbtypes.h b/gdb/gdbtypes.h
index 769328cc9cd..99273d14c1f 100644
--- a/gdb/gdbtypes.h
+++ b/gdb/gdbtypes.h
@@ -2092,7 +2092,6 @@ extern void allocate_gnat_aux_type (struct type *);
 #define TYPE_REFERENCE_TYPE(thistype) (thistype)->reference_type
 #define TYPE_RVALUE_REFERENCE_TYPE(thistype) (thistype)->rvalue_reference_type
 #define TYPE_CHAIN(thistype) (thistype)->chain
-#define TYPE_DYN_PROP(thistype)  TYPE_MAIN_TYPE(thistype)->dyn_prop_list
 /* * Note that if thistype is a TYPEDEF type, you have to call check_typedef.
    But check_typedef does set the TYPE_LENGTH of the TYPEDEF type,
    so you only have to call check_typedef once.  Since allocate_value
@@ -2882,6 +2881,9 @@ extern struct type *copy_type_recursive (struct objfile *objfile,
 					 struct type *type,
 					 htab_t copied_types);
 
+extern struct dynamic_prop_list * copy_dynamic_prop_list
+  (struct obstack *objfile_obstack, struct dynamic_prop_list *list);
+
 extern struct type *copy_type (const struct type *type);
 
 extern bool types_equal (struct type *, struct type *);
diff --git a/gdb/testsuite/gdb.fortran/assumedrank.exp b/gdb/testsuite/gdb.fortran/assumedrank.exp
index 69cd168125f..e9429b44a9a 100644
--- a/gdb/testsuite/gdb.fortran/assumedrank.exp
+++ b/gdb/testsuite/gdb.fortran/assumedrank.exp
@@ -58,6 +58,12 @@ while { $test_count < 500 } {
 	    }
 	}
 
+	# Currently, flang does not support rank0.
+	if {$test_count == 1 && [test_compiler_info {clang-*}]} {
+	   unsupported "compiler does not support rank 0"
+	   continue
+	}
+
 	if ($found_final_breakpoint) {
 	    break
 	}
diff --git a/gdb/testsuite/gdb.fortran/assumedrank.f90 b/gdb/testsuite/gdb.fortran/assumedrank.f90
index 7f077c3f014..7f7cf2c1f3e 100644
--- a/gdb/testsuite/gdb.fortran/assumedrank.f90
+++ b/gdb/testsuite/gdb.fortran/assumedrank.f90
@@ -19,16 +19,19 @@
 
 PROGRAM  arank
 
+  REAL :: array0
   REAL :: array1(10)
   REAL :: array2(1, 2)
   REAL :: array3(3, 4, 5)
   REAL :: array4(4, 5, 6, 7)
 
+  array0 = 0
   array1 = 1.0
   array2 = 2.0
   array3 = 3.0
   array4 = 4.0
 
+  call test_rank (array0)
   call test_rank (array1)
   call test_rank (array2)
   call test_rank (array3)
-- 
2.17.1