File: sorttest.f

package info (click to toggle)
babel 0.10.2-1
  • links: PTS
  • area: contrib
  • in suites: sarge
  • size: 43,932 kB
  • ctags: 29,707
  • sloc: java: 74,695; ansic: 73,142; cpp: 40,649; sh: 18,411; f90: 10,062; fortran: 6,727; python: 6,406; makefile: 3,866; xml: 118; perl: 48
file content (80 lines) | stat: -rw-r--r-- 2,583 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
c
c     File:       sorttest.f
c     Copyright:  (c) 2002 The Regents of the University of California
c     Revision:   @(#) $Revision: 4434 $
c     Date:       $Date: 2005-03-17 09:05:29 -0800 (Thu, 17 Mar 2005) $
c     Description:Exercise the FORTRAN interface for sorting
c
c
      subroutine starttest(number)
      implicit none
      integer*4 number
      integer*8 tracker
      call synch_RegOut_getInstance_f(tracker)
      call synch_RegOut_startPart_f(tracker, number)
      call synch_RegOut_deleteRef_f(tracker)
      end

      subroutine reporttest(test, number)
      implicit none
      integer*8 tracker
      integer*4 number
      logical test
      call synch_RegOut_getInstance_f(tracker)
      if (test) then
         call synch_RegOut_endPart_f(tracker, number, 0)
      else
         call synch_RegOut_endPart_f(tracker, number, 1)
      endif
      call synch_RegOut_deleteRef_f(tracker)
      number = number + 1
      end

      subroutine testsort(test)
      implicit none
      integer*8 algs, merge, quick, heap, alg
      integer*4 test
      logical retval

      call sort_SortingAlgorithm__array_create1d_f(3, algs)
      call starttest(test)
      call sort_MergeSort__create_f(merge)
      call reporttest(merge .ne. 0, test)
      call starttest(test)
      call sort_QuickSort__create_f(quick)
      call reporttest(quick .ne. 0, test)
      call starttest(test)
      call sort_HeapSort__create_f(heap)
      call reporttest(heap .ne. 0, test)

      call sort_SortingAlgorithm__cast_f(merge, alg)
      call sort_SortingAlgorithm__array_set1_f(algs, 0, alg)
      call sort_SortingAlgorithm__cast_f(heap, alg)
      call sort_SortingAlgorithm__array_set1_f(algs, 1, alg)
      call sort_SortingAlgorithm__cast_f(quick, alg)
      call sort_SortingAlgorithm__array_set1_f(algs, 2, alg)
c     remove extraneous references
      call sort_MergeSort_deleteRef_f(merge)
      call sort_QuickSort_deleteRef_f(quick)
      call sort_HeapSort_deleteRef_f(heap)

      call starttest(test)
      call sort_SortTest_stressTest_f(algs, retval)
      call reporttest(retval, test)
      call sort_SortingAlgorithm__array_deleteRef_f(algs)

      end

      program sorttest
      implicit none
      integer*4 test
      integer*8 tracker
      test = 1
      call synch_RegOut_getInstance_f(tracker)
      call synch_RegOut_setExpectations_f(tracker, 4)
      call synch_RegOut_writeComment_f(tracker,
     $      'Sort tests')
      call testsort(test)
      call synch_RegOut_close_f(tracker)
      call synch_RegOut_deleteRef_f(tracker)
      end