gdb/fortran: Support for assumed rank zero
authorrupothar <rupesh.potharla@amd.com>
Fri, 8 Apr 2022 10:35:41 +0000 (16:05 +0530)
committerKavitha Natarajan <kavitha.natarajan@amd.com>
Mon, 25 Apr 2022 09:28:30 +0000 (14:58 +0530)
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
gdb/gdbtypes.h
gdb/testsuite/gdb.fortran/assumedrank.exp
gdb/testsuite/gdb.fortran/assumedrank.f90

index 49ecb199b0709b096b6c3d08cd102857c1ca710b..2a51372a0372468ea12889f068dbf2b7c92dc1e4 100644 (file)
@@ -47,6 +47,9 @@
 /* The value of an invalid conversion badness.  */
 #define INVALID_CONVERSION 100
 
+static struct dynamic_prop_list *
+copy_dynamic_prop_list (struct obstack *, struct dynamic_prop_list *);
+
 /* Initialize BADNESS constants.  */
 
 const struct rank LENGTH_MISMATCH_BADNESS = {INVALID_CONVERSION,0};
@@ -2398,10 +2401,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)
        {
index 769328cc9cd553290bf0d68a0c868cee5f60ef1e..7437e1db8ab08d897be9e7d62e249a957f1e491b 100644 (file)
@@ -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
index 69cd168125f24a91961463f3f8d86537cd0d625b..e9429b44a9a99b6e617c5616ea6b2441d1534fb0 100644 (file)
@@ -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
        }
index 7f077c3f01400d587a60eaa0103f4e32a97dc00c..7f7cf2c1f3e4b8758508f3fd2502a356f38a0746 100644 (file)
 
 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)