Merge pull request #135 from swig-fortran/improve-memory

Improve robustness of assignment

Author: sethrj

Examples/fortran/arrayview/runme.f90

@@ -1,7 +1,10 @@
 ! File : runme.f90
 
 program main
+  use ISO_FORTRAN_ENV
   implicit none
+  integer, parameter :: STDOUT = OUTPUT_UNIT
+
   call test_algorithms()
   call test_matview()
 
@@ -20,17 +23,17 @@ subroutine test_algorithms()
   ! Allocate and reverse integer data
   allocate(alloc_data(size(test_data)))
   alloc_data = test_data
-  write (0,list_fmt) alloc_data
+  write(STDOUT,list_fmt) alloc_data
   call reverse(alloc_data)
-  write (0,list_fmt) alloc_data
+  write(STDOUT,list_fmt) alloc_data
 
   call print_array(test_real)
   call sort(test_real)
   call reverse(test_real)
   call print_array(test_real)
 
   do i = -2,8
-    write(0, "(i4,""->"",i4)") i, find_sorted(test_data, i)
+    write(STDOUT, "(i4,""->"",i4)") i, find_sorted(test_data, i)
   enddo
 end subroutine
 
@@ -47,12 +50,12 @@ subroutine test_matview()
     arr(i) = real(i) + 0.5
   end do
 
-  write(0, *) "Printing array..."
+  write(STDOUT, *) "Printing array..."
   call print_array(arr)
-  write(0, *) "... printed"
+  write(STDOUT, *) "... printed"
 
   ! Empty array
-  write(0, *) "Printing empty..."
+  write(STDOUT, *) "Printing empty..."
   allocate(alloc(0))
   call print_array(alloc)
 
@@ -64,28 +67,28 @@ subroutine test_matview()
   enddo
 
   ! Printing a single column works
-  write(0,*) "---- Column access is OK ----"
+  write(STDOUT,*) "---- Column access is OK ----"
   do i = 1,3
-    write(0, *) "Printing 2D array col ", i, " slice..."
+    write(STDOUT, *) "Printing 2D array col ", i, " slice..."
     call print_array(mat(:,i))
   enddo
 
   ! THIS PRINTS BAD DATA for columns since they're not contiguous
   ! (fortran is row-major)
-  write(0,*) "---- Row access is NOT ok ----"
+  write(STDOUT,*) "---- Row access is NOT ok ----"
 
   do i = 1,3
-    write(0, *) "Printing 2D array row ", i, " slice..."
+    write(STDOUT, *) "Printing 2D array row ", i, " slice..."
     call print_array(mat(i,:))
   enddo
 
   ! Copy a column to a temporary vector instead
   deallocate(alloc)
   allocate(alloc(3))
 
-  write(0,*) "---- Correct row access ----"
+  write(STDOUT,*) "---- Correct row access ----"
   do i = 1,3
-    write(0, *) "Printing 2D array row ", i, " slice..."
+    write(STDOUT, *) "Printing 2D array row ", i, " slice..."
     alloc(:) = mat(i,:)
     call print_array(alloc)
   enddo

Examples/fortran/bare/runme.f90

@@ -1,7 +1,10 @@
 ! File : runme.f90
 
 program main
+  use ISO_FORTRAN_ENV
   implicit none
+  integer, parameter :: STDOUT = OUTPUT_UNIT
+
   call test_funcs()
   call test_enum()
   call test_consts()
@@ -16,14 +19,14 @@ subroutine test_funcs()
   call set_something(2, 200.0d0)
   call set_something(1, 10.0d0)
   call set_something(0, 1.0d0)
-  write(0, *) "Got ", get_something(0)
-  write(0, *) "Got ", get_something(1)
+  write(STDOUT, *) "Got ", get_something(0)
+  write(STDOUT, *) "Got ", get_something(1)
 
   rptr => get_something_rref(2)
   rptr = 512.0d0
 
   call get_something_ref(1, temp)
-  write(0, *) "Got ", temp
+  write(STDOUT, *) "Got ", temp
 
 end subroutine test_funcs
 
@@ -44,12 +47,12 @@ subroutine test_consts()
   use example
   use, intrinsic :: ISO_C_BINDING
   implicit none
-  write(0, *) "MY_SPECIAL_NUMBERS ", MY_SPECIAL_NUMBERS
-  write(0, *) "octoconst   ", octal_const
-  write(0, *) "wrapped_const ", wrapped_const
-  write(0, *) "pi is approximately ", approx_pi
-  write(0, *) "2pi is approximately ", get_approx_twopi()
-  write(0, *) "extern const int is ", get_linked_const_int()
+  write(STDOUT, *) "MY_SPECIAL_NUMBERS ", MY_SPECIAL_NUMBERS
+  write(STDOUT, *) "octoconst   ", octal_const
+  write(STDOUT, *) "wrapped_const ", wrapped_const
+  write(STDOUT, *) "pi is approximately ", approx_pi
+  write(STDOUT, *) "2pi is approximately ", get_approx_twopi()
+  write(STDOUT, *) "extern const int is ", get_linked_const_int()
   ! Can't assign these
 !   wrapped_const = 2
 !   MY_SPECIAL_NUMBERS = 4

Examples/fortran/bindc/runme.f90

@@ -1,7 +1,10 @@
 ! File : runme.f90
 
 program main
+  use ISO_FORTRAN_ENV
   implicit none
+  integer, parameter :: STDOUT = OUTPUT_UNIT
+
   call test_example()
   call test_logical()
   call test_strings()
@@ -28,17 +31,17 @@ subroutine test_logical()
   logical :: ninp, noutp
   inp = .true.
   outp = bound_negation(inp)
-  write(0, *) "Should be true:", inp, "; should be false: ", outp
+  write(STDOUT, *) "Should be true:", inp, "; should be false: ", outp
   inp = .false.
   outp = bound_negation(inp)
-  write(0, *) "Should be false:", inp, "; should be true: ", outp
+  write(STDOUT, *) "Should be false:", inp, "; should be true: ", outp
 
   ninp = .true.
   noutp = wrapped_negation(ninp)
-  write(0, *) "Should be true:", ninp, "; should be false: ", noutp
+  write(STDOUT, *) "Should be true:", ninp, "; should be false: ", noutp
   ninp = .false.
   noutp = wrapped_negation(ninp)
-  write(0, *) "Should be false:", ninp, "; should be true: ", noutp
+  write(STDOUT, *) "Should be false:", ninp, "; should be true: ", noutp
 end subroutine
 
 subroutine test_strings()
@@ -49,23 +52,23 @@ subroutine test_strings()
   character(len=:), allocatable :: str
 
   do i = -1, 3
-    write(0, *) get_existing_string(i)
+    write(STDOUT, *) get_existing_string(i)
   end do
 
   ! Note: automatic allocation is allowed in Fortran 2003, but GCC tends to
   ! produce spurious warnings about "maybe uninitialized".
   !str = concat("String a", "string b")
   ! Alternatively you can explicitly allocate the string:
   allocate(str, source=concat("String a", "string b"))
-  write(0, *) "Concatenated string: '"//str//"'"
+  write(STDOUT, *) "Concatenated string: '"//str//"'"
 end subroutine
 
 subroutine test_global()
   use ISO_C_BINDING
   use example
   implicit none
   my_global_var = 2
-  write(0, "(/a, i2/)") "Global variable: ", get_my_global_var()
+  write(STDOUT, "(/a, i2/)") "Global variable: ", get_my_global_var()
 
 end subroutine
 

Examples/fortran/callback/runme.f90

@@ -21,8 +21,10 @@ function bracket(s) &
   end function
 end module
 
-program test_callback
+program runme
+  use ISO_FORTRAN_ENV
   implicit none
+  integer, parameter :: STDOUT = OUTPUT_UNIT
 
   call test_procptr()
   call test_transform()
@@ -36,12 +38,12 @@ subroutine test_procptr
   implicit none
   procedure(fp_transform), pointer :: trans => null()
 
-  write(*,*) "test_procptr"
+  write(STDOUT,*) "test_procptr"
 
   trans => enquote_single
-  write(*,*) "Result: " // trans("whee")
+  write(STDOUT,*) "Result: " // trans("whee")
   trans => bracket
-  write(*,*) "Result: " // trans("whee")
+  write(STDOUT,*) "Result: " // trans("whee")
 end subroutine
 
 ! Actual C++ callback function test
@@ -51,10 +53,10 @@ subroutine test_transform
   implicit none
   character(kind=C_CHAR, len=:), allocatable :: str 
 
-  write(*,*) "test_transform"
+  write(STDOUT,*) "test_transform"
 
   str = join_transformed(", and ", enquote_cb)
-  write(0,*) "Got string: " // str
+  write(STDOUT,*) "Got string: " // str
 end subroutine
 
 ! Actual C++ callback to wrapped Function procedure
@@ -65,21 +67,21 @@ subroutine test_cb
   implicit none
   character(kind=C_CHAR, len=:), allocatable :: str 
 
-  write(*,*) "test_cb"
+  write(STDOUT,*) "test_cb"
 
   ! Choose the internal Fortran procedure to wrap
   director_procptr => enquote_single
 
   ! Call the C++ function with the callback function that wraps the interface
   ! function that calls "director_procptr"
   str = join_transformed(", and ", director_cb)
-  write(0,*) "Got string: " // str
+  write(STDOUT,*) "Got string: " // str
 
   ! Choose the internal Fortran procedure to wrap
   director_procptr => bracket
 
   str = join_transformed(", and ", director_cb)
-  write(0,*) "Got string: " // str
+  write(STDOUT,*) "Got string: " // str
 end subroutine 
 
 end program

Examples/fortran/class/runme.f90

@@ -1,5 +1,9 @@
 ! File : runme.f90
-program class_runme
+program runme
+  use ISO_FORTRAN_ENV
+  implicit none
+  integer, parameter :: STDOUT = OUTPUT_UNIT
+
   call run()
 contains
 
@@ -15,12 +19,12 @@ subroutine run()
 
   ! ----- Object creation -----
 
-  write(*,*) "Creating some objects"
+  write(STDOUT,*) "Creating some objects"
   c = Circle(10.0)
   s = Square(10.0)
 
   ! ----- Access a static member -----
-  write(*,'(a,i2,a)')"A total of", s%get_nshapes(), " shapes were created"
+  write(STDOUT,'(a,i2,a)')"A total of", s%get_nshapes(), " shapes were created"
 
   ! ----- Member data access -----
 
@@ -34,24 +38,24 @@ subroutine run()
   call sh%set_x(-10.0)
   call sh%set_y(  5.0)
 
-  write(*,*)"Here is their current position:"
-  write(*,'(a,f5.1,a,f5.1,a)')"  Circle = (", c%get_x(), ",", c%get_y(), " )"
-  write(*,'(a,f5.1,a,f5.1,a)')"  Square = (", s%get_x(), ",", s%get_y(), " )"
+  write(STDOUT,*)"Here is their current position:"
+  write(STDOUT,'(a,f5.1,a,f5.1,a)')"  Circle = (", c%get_x(), ",", c%get_y(), " )"
+  write(STDOUT,'(a,f5.1,a,f5.1,a)')"  Square = (", s%get_x(), ",", s%get_y(), " )"
 
   ! ----- Call some methods -----
 
-  write(*,*)"Here are some properties of the shapes:"
+  write(STDOUT,*)"Here are some properties of the shapes:"
   call print_shape(c)
   call print_shape(s)
 
   ! Call function that takes base class
-  write(*,*)" Circle P/A  = ", surface_to_volume(c)
-  write(*,*)" Square P/A  = ", surface_to_volume(s)
+  write(STDOUT,*)" Circle P/A  = ", surface_to_volume(c)
+  write(STDOUT,*)" Square P/A  = ", surface_to_volume(s)
 
   ! Example of exception handling
   c = circle(-2.0)
   if (ierr /= 0) then
-    write(*,*) "Caught the following error: ", get_serr()
+    write(STDOUT,*) "Caught the following error: ", get_serr()
     ierr = 0
   endif
 
@@ -62,13 +66,13 @@ subroutine run()
   call s%release()
 
   n_shapes = c%get_nshapes() 
-  write(*,*) n_shapes, "shapes remain"
+  write(STDOUT,*) n_shapes, "shapes remain"
   if (n_shapes /= 0) then
-    write(*,*) "Shapes were not freed properly!"
+    write(STDOUT,*) "Shapes were not freed properly!"
     stop 1
   endif
 
-  write(*,*) "Goodbye"
+  write(STDOUT,*) "Goodbye"
 end subroutine
 
 subroutine print_shape(s)
@@ -77,9 +81,9 @@ subroutine print_shape(s)
   implicit none
   class(Shape), intent(in) :: s
 
-  write(*,*)"  ", s%kind(), ":"
-  write(*,*)"    area      = ",s%area()
-  write(*,*)"    perimeter = ",s%perimeter()
+  write(STDOUT,*)"  ", s%kind(), ":"
+  write(STDOUT,*)"    area      = ",s%area()
+  write(STDOUT,*)"    perimeter = ",s%perimeter()
 end subroutine
 
 end program