From FEDORA_PATCHES Mon Sep 17 00:00:00 2001

From: Fedora GDB patches <invalid@email.com>

Date: Fri, 27 Oct 2017 21:07:50 +0200

Subject: gdb-vla-intel-tests.patch

;;=fedoratest

diff --git a/gdb/testsuite/gdb.fortran/ptr-indentation.exp b/gdb/testsuite/gdb.fortran/ptr-indentation.exp

--- a/gdb/testsuite/gdb.fortran/ptr-indentation.exp

+++ b/gdb/testsuite/gdb.fortran/ptr-indentation.exp

@@ -37,5 +37,5 @@ gdb_continue_to_breakpoint "BP1"

 gdb_test "ptype tinsta" \

   [multi_line "type = Type tuserdef" \

               "    $int :: i" \

-              "    PTR TO -> \\( $real :: ptr \\)" \

+              "    PTR TO -> \\( $real :: ptr\\)" \

               "End Type tuserdef"]

diff --git a/gdb/testsuite/gdb.fortran/ptype-on-functions.exp b/gdb/testsuite/gdb.fortran/ptype-on-functions.exp

--- a/gdb/testsuite/gdb.fortran/ptype-on-functions.exp

+++ b/gdb/testsuite/gdb.fortran/ptype-on-functions.exp

@@ -42,4 +42,4 @@ gdb_test "ptype say_numbers" \

     "type = void \\(integer\\(kind=4\\), integer\\(kind=4\\), integer\\(kind=4\\)\\)"

 gdb_test "ptype fun_ptr" \

-    "type = PTR TO -> \\( integer\\(kind=4\\) \\(\\) \\(REF TO -> \\( integer\\(kind=4\\) \\)\\) \\)"

+    "type = PTR TO -> \\( integer\\(kind=4\\) \\(\\) \\(REF TO -> \\( integer\\(kind=4\\)\\)\\)\\)"

diff --git a/gdb/testsuite/gdb.fortran/vla-func.exp b/gdb/testsuite/gdb.fortran/vla-func.exp

new file mode 100644

--- /dev/null

+++ b/gdb/testsuite/gdb.fortran/vla-func.exp

@@ -0,0 +1,61 @@

+# Copyright 2014 Free Software Foundation, Inc.

+

+# This program is free software; you can redistribute it and/or modify

+# it under the terms of the GNU General Public License as published by

+# the Free Software Foundation; either version 3 of the License, or

+# (at your option) any later version.

+#

+# This program is distributed in the hope that it will be useful,

+# but WITHOUT ANY WARRANTY; without even the implied warranty of

+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

+# GNU General Public License for more details.

+#

+# You should have received a copy of the GNU General Public License

+# along with this program.  If not, see <http://www.gnu.org/licenses/>.

+

+standard_testfile ".f90"

+

+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \

+    {debug f90 quiet}] } {

+    return -1

+}

+

+if ![runto MAIN__] then {

+    perror "couldn't run to breakpoint MAIN__"

+    continue

+}

+

+# Check VLA passed to first Fortran function.

+gdb_breakpoint [gdb_get_line_number "func1-vla-passed"]

+gdb_continue_to_breakpoint "func1-vla-passed"

+gdb_test "print vla" " = \\( *\\( *22, *22, *22,\[()22, .\]*\\)" \

+  "print vla (func1)"

+gdb_test "ptype vla" "type = integer\\\(kind=4\\\), allocatable \\\(10,10\\\)" \

+  "ptype vla (func1)"

+

+gdb_breakpoint [gdb_get_line_number "func1-vla-modified"]

+gdb_continue_to_breakpoint "func1-vla-modified"

+gdb_test "print vla(5,5)" " = 55" "print vla(5,5) (func1)"

+gdb_test "print vla(7,7)" " = 77" "print vla(5,5) (func1)"

+

+# Check if the values are correct after returning from func1

+gdb_breakpoint [gdb_get_line_number "func1-returned"]

+gdb_continue_to_breakpoint "func1-returned"

+gdb_test "print ret" " = .TRUE." "print ret after func1 returned"

+

+# Check VLA passed to second Fortran function

+gdb_breakpoint [gdb_get_line_number "func2-vla-passed"]

+gdb_continue_to_breakpoint "func2-vla-passed"

+gdb_test "print vla" \

+  " = \\\(44, 44, 44, 44, 44, 44, 44, 44, 44, 44\\\)" \

+  "print vla (func2)"

+gdb_test "ptype vla" "type = integer\\\(kind=4\\\) \\\(10\\\)" \

+  "ptype vla (func2)"

+

+# Check if the returned VLA has the correct values and ptype.

+gdb_breakpoint [gdb_get_line_number "func2-returned"]

+gdb_continue_to_breakpoint "func2-returned"

+gdb_test "print vla3" " = \\\(1, 2, 44, 4, 44, 44, 44, 8, 44, 44\\\)" \

+  "print vla3 (after func2)"

+gdb_test "ptype vla3" "type = integer\\\(kind=4\\\), allocatable \\\(10\\\)" \

+  "ptype vla3 (after func2)"

diff --git a/gdb/testsuite/gdb.fortran/vla-func.f90 b/gdb/testsuite/gdb.fortran/vla-func.f90

new file mode 100644

--- /dev/null

+++ b/gdb/testsuite/gdb.fortran/vla-func.f90

@@ -0,0 +1,71 @@

+! Copyright 2014 Free Software Foundation, Inc.

+!

+! This program is free software; you can redistribute it and/or modify

+! it under the terms of the GNU General Public License as published by

+! the Free Software Foundation; either version 2 of the License, or

+! (at your option) any later version.

+!

+! This program is distributed in the hope that it will be useful,

+! but WITHOUT ANY WARRANTY; without even the implied warranty of

+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

+! GNU General Public License for more details.

+!

+! You should have received a copy of the GNU General Public License

+! along with this program; if not, write to the Free Software

+! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

+

+logical function func1 (vla)

+  implicit none

+  integer, allocatable :: vla (:, :)

+  func1 = allocated(vla)

+  vla(5,5) = 55               ! func1-vla-passed

+  vla(7,7) = 77

+  return                      ! func1-vla-modified

+end function func1

+

+function func2(vla)

+  implicit none

+  integer :: vla (:)

+  integer :: func2(size(vla))

+  integer :: k

+

+  vla(1) = 1                    ! func2-vla-passed

+  vla(2) = 2

+  vla(4) = 4

+  vla(8) = 8

+

+  func2 = vla

+end function func2

+

+program vla_func

+  implicit none

+  interface

+    logical function func1 (vla)

+      integer, allocatable :: vla (:, :)

+    end function

+  end interface

+  interface

+    function func2 (vla)

+      integer :: vla (:)

+      integer func2(size(vla))

+    end function

+  end interface

+

+  logical :: ret

+  integer, allocatable :: vla1 (:, :)

+  integer, allocatable :: vla2 (:)

+  integer, allocatable :: vla3 (:)

+

+  ret = .FALSE.

+

+  allocate (vla1 (10,10))

+  vla1(:,:) = 22

+

+  allocate (vla2 (10))

+  vla2(:) = 44

+

+  ret = func1(vla1)

+  vla3 = func2(vla2)          ! func1-returned

+

+  ret = .TRUE.                ! func2-returned

+end program vla_func

diff --git a/gdb/testsuite/gdb.fortran/vla-ptr-info.exp b/gdb/testsuite/gdb.fortran/vla-ptr-info.exp

--- a/gdb/testsuite/gdb.fortran/vla-ptr-info.exp

+++ b/gdb/testsuite/gdb.fortran/vla-ptr-info.exp

@@ -28,5 +28,5 @@ if ![runto_main] {

 # Check the status of a pointer to a dynamic array.

 gdb_breakpoint [gdb_get_line_number "pvla-associated"]

 gdb_continue_to_breakpoint "pvla-associated"

-gdb_test "print &pvla" " = \\(PTR TO -> \\( real\\(kind=4\\) \\(10,10,10\\) \\)\\) ${hex}" \

+gdb_test "print &pvla" " = \\(PTR TO -> \\( real\\(kind=4\\) \\(10,10,10\\)\\)\\) ${hex}" \

   "print pvla pointer information"

diff --git a/gdb/testsuite/gdb.fortran/vla-stringsold.exp b/gdb/testsuite/gdb.fortran/vla-stringsold.exp

new file mode 100644

--- /dev/null

+++ b/gdb/testsuite/gdb.fortran/vla-stringsold.exp

@@ -0,0 +1,101 @@

+# Copyright 2014 Free Software Foundation, Inc.

+

+# This program is free software; you can redistribute it and/or modify

+# it under the terms of the GNU General Public License as published by

+# the Free Software Foundation; either version 3 of the License, or

+# (at your option) any later version.

+#

+# This program is distributed in the hope that it will be useful,

+# but WITHOUT ANY WARRANTY; without even the implied warranty of

+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

+# GNU General Public License for more details.

+#

+# You should have received a copy of the GNU General Public License

+# along with this program.  If not, see <http://www.gnu.org/licenses/>.

+

+standard_testfile ".f90"

+

+if { [prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \

+    {debug f90 quiet}] } {

+    return -1

+}

+

+# check that all fortran standard datatypes will be

+# handled correctly when using as VLA's

+

+if ![runto MAIN__] then {

+    perror "couldn't run to breakpoint MAIN__"

+    continue

+}

+

+gdb_breakpoint [gdb_get_line_number "var_char-allocated-1"]

+gdb_continue_to_breakpoint "var_char-allocated-1"

+gdb_test "print var_char" \

+  " = \\(PTR TO -> \\( character\\*10\\)\\) ${hex}" \

+  "print var_char after allocated first time"

+gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*10\\)" \

+  "whatis var_char first time"

+gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*10\\)" \

+  "ptype var_char first time"

+gdb_test "next" "\\d+.*var_char = 'foo'.*" \

+  "next to allocation status of var_char"

+gdb_test "print l" " = .TRUE." "print allocation status first time"

+

+gdb_breakpoint [gdb_get_line_number "var_char-filled-1"]

+gdb_continue_to_breakpoint "var_char-filled-1"

+gdb_test "print var_char" \

+  " = \\(PTR TO -> \\( character\\*3\\)\\) ${hex}" \

+  "print var_char after filled first time"

+gdb_test "print *var_char" " = 'foo'" \

+  "print *var_char after filled first time"

+gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*3\\)" \

+  "whatis var_char after filled first time"

+gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*3\\)" \

+  "ptype var_char after filled first time"

+gdb_test "print var_char(1)" " = 102 'f'" "print var_char(1)"

+gdb_test "print var_char(3)" " = 111 'o'" "print var_char(3)"

+

+gdb_breakpoint [gdb_get_line_number "var_char-filled-2"]

+gdb_continue_to_breakpoint "var_char-filled-2"

+gdb_test "print var_char" \

+  " = \\(PTR TO -> \\( character\\*6\\)\\) ${hex}" \

+  "print var_char after allocated second time"

+gdb_test "print *var_char" " = 'foobar'" \

+  "print *var_char after allocated second time"

+gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*6\\)" \

+  "whatis var_char second time"

+gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*6\\)" \

+  "ptype var_char second time"

+

+gdb_breakpoint [gdb_get_line_number "var_char-empty"]

+gdb_continue_to_breakpoint "var_char-empty"

+gdb_test "print var_char" \

+  " = \\(PTR TO -> \\( character\\*0\\)\\) ${hex}" \

+  "print var_char after set empty"

+gdb_test "print *var_char" " = \"\"" "print *var_char after set empty"

+gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*0\\)" \

+  "whatis var_char after set empty"

+gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*0\\)" \

+  "ptype var_char after set empty"

+

+gdb_breakpoint [gdb_get_line_number "var_char-allocated-3"]

+gdb_continue_to_breakpoint "var_char-allocated-3"

+gdb_test "print var_char" \

+  " = \\(PTR TO -> \\( character\\*21\\)\\) ${hex}" \

+  "print var_char after allocated third time"

+gdb_test "whatis var_char" "type = PTR TO -> \\( character\\*21\\)" \

+  "whatis var_char after allocated third time"

+gdb_test "ptype var_char" "type = PTR TO -> \\( character\\*21\\)" \

+  "ptype var_char after allocated third time"

+

+gdb_breakpoint [gdb_get_line_number "var_char_p-associated"]

+gdb_continue_to_breakpoint "var_char_p-associated"

+gdb_test "print var_char_p" \

+  " = \\(PTR TO -> \\( character\\*7\\)\\) ${hex}" \

+  "print var_char_p after associated"

+gdb_test "print *var_char_p" " = 'johndoe'" \

+  "print *var_char_ after associated"

+gdb_test "whatis var_char_p" "type = PTR TO -> \\( character\\*7\\)" \

+  "whatis var_char_p after associated"

+gdb_test "ptype var_char_p" "type = PTR TO -> \\( character\\*7\\)" \

+  "ptype var_char_p after associated"

diff --git a/gdb/testsuite/gdb.fortran/vla-stringsold.f90 b/gdb/testsuite/gdb.fortran/vla-stringsold.f90

new file mode 100644

--- /dev/null

+++ b/gdb/testsuite/gdb.fortran/vla-stringsold.f90

@@ -0,0 +1,40 @@

+! Copyright 2014 Free Software Foundation, Inc.

+!

+! This program is free software; you can redistribute it and/or modify

+! it under the terms of the GNU General Public License as published by

+! the Free Software Foundation; either version 2 of the License, or

+! (at your option) any later version.

+!

+! This program is distributed in the hope that it will be useful,

+! but WITHOUT ANY WARRANTY; without even the implied warranty of

+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

+! GNU General Public License for more details.

+!

+! You should have received a copy of the GNU General Public License

+! along with this program; if not, write to the Free Software

+! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

+

+program vla_strings

+  character(len=:), target, allocatable   :: var_char

+  character(len=:), pointer               :: var_char_p

+  logical                                 :: l

+

+  allocate(character(len=10) :: var_char)

+  l = allocated(var_char)                 ! var_char-allocated-1

+  var_char = 'foo'

+  deallocate(var_char)                    ! var_char-filled-1

+  l = allocated(var_char)                 ! var_char-deallocated

+  allocate(character(len=42) :: var_char)

+  l = allocated(var_char)

+  var_char = 'foobar'

+  var_char = ''                           ! var_char-filled-2

+  var_char = 'bar'                        ! var_char-empty

+  deallocate(var_char)

+  allocate(character(len=21) :: var_char)

+  l = allocated(var_char)                 ! var_char-allocated-3

+  var_char = 'johndoe'

+  var_char_p => var_char

+  l = associated(var_char_p)              ! var_char_p-associated

+  var_char_p => null()

+  l = associated(var_char_p)              ! var_char_p-not-associated

+end program vla_strings

diff --git a/gdb/testsuite/gdb.fortran/whatis_type.exp b/gdb/testsuite/gdb.fortran/whatis_type.exp

--- a/gdb/testsuite/gdb.fortran/whatis_type.exp

+++ b/gdb/testsuite/gdb.fortran/whatis_type.exp

@@ -44,7 +44,7 @@ gdb_test "whatis t2" "type = Type t2"

 gdb_test "whatis t2v" "type = Type t2"

 gdb_test "whatis t3" "type = Type t3"

 gdb_test "whatis t3v" "type = Type t3"

-gdb_test "whatis t3p" "type = PTR TO -> \\( Type t3 \\)"

+gdb_test "whatis t3p" "type = PTR TO -> \\( Type t3\\)"

 gdb_test "ptype t1" \

   [multi_line "type = Type t1" \

@@ -73,4 +73,4 @@ gdb_test "ptype t3p" \

   [multi_line "type = PTR TO -> \\( Type t3" \

               "    $int :: t3_i" \

               "    Type t2 :: t2_n" \

-              "End Type t3 \\)"]

+              "End Type t3\\)"]