Merge pull request #50 from sourceryinstitute/fix-47

Fix Construction From JSON

Author: Damian Rouson

.github/workflows/CI.yml

@@ -27,10 +27,10 @@ jobs:
 
     - name: Install GFortran, OpenCoarrays,and fpm
       run: |
-        sudo apt install -y gfortran-10 graphviz
-        sudo update-alternatives --install /usr/bin/gcc gcc /usr/bin/gcc-10 100 \
-        --slave /usr/bin/gfortran gfortran /usr/bin/gfortran-10 \
-        --slave /usr/bingcov gcov /usr/bin/gcov-10
+        sudo apt install -y gfortran-11 graphviz
+        sudo update-alternatives --install /usr/bin/gcc gcc /usr/bin/gcc-11 100 \
+        --slave /usr/bin/gfortran gfortran /usr/bin/gfortran-11 \
+        --slave /usr/bingcov gcov /usr/bin/gcov-11
         if [ ! -d OpenCoarrays-2.9.2 ] ; then wget -P . https://github.com/sourceryinstitute/OpenCoarrays/releases/download/2.9.2/OpenCoarrays-2.9.2.tar.gz && tar -xf OpenCoarrays-2.9.2.tar.gz && cd OpenCoarrays-2.9.2 && TERM=xterm ./install.sh -y; fi
         wget https://github.com/fortran-lang/fpm/releases/download/v0.1.3/fpm-0.1.3-linux-x86_64 && sudo cp fpm-0.1.3-linux-x86_64 /usr/local/bin/fpm && sudo chmod a+x /usr/local/bin/fpm
 

src/dag_s.f90

@@ -55,9 +55,9 @@ recursive subroutine depth_first_search(v, d, s, o)
       integer, intent(in) :: v, d(:)
       integer, intent(out), allocatable :: s(:)
       integer, intent(inout), allocatable :: o(:)
-      
+
       call assert(.not. any(v == d), "depth_first_search: cycle detected", intrinsic_array_t([v,d]))
-        
+
       block
         integer, allocatable :: dependencies(:), s_local(:), d_local(:)
         integer w
@@ -73,29 +73,29 @@ recursive subroutine depth_first_search(v, d, s, o)
             s_local = d_local
           end if
         end do
-        
+
         if (.not. any(v == o)) o = [v, o]
         s = [v, s_local]
       end block
 
     end subroutine
 
   end function toposort
-                                   
+
   module procedure is_sorted_and_acyclic
-    
+
     if (.not. allocated(self%order)) then
       is_sorted_and_acyclic = .false.
       return
     end if
-    
+
     associate(num_vertices => size(self%vertices), order_size => size(self%order))
       call assert(order_size == num_vertices, "dag_t%is_sorted_and_acyclic: size(self%vertices) == size(self%order)", &
         intrinsic_array_t([order_size, num_vertices]))
-    
+
       block
         integer i, j
-    
+
         do i = 1, num_vertices
           associate(edges => self%vertices(self%order(i))%get_edges())
             do j = 1, size(edges)
@@ -106,55 +106,30 @@ end function toposort
             end do
           end associate
         end do
-            
+
         is_sorted_and_acyclic = .true.
       end block
-    
+
     end associate
-    
+
   end procedure
 
   module procedure construct_from_json
     type(fallible_json_value_t) :: maybe_vertices
 
+    maybe_vertices = json_object%get_element("vertices")
     associate(errors => maybe_vertices%errors())
       call assert(.not. errors%has_any(), "dag_s construct_from_json: .not. errors%has_any()", char(errors%to_string()))
     end associate
 
     select type (vertices => maybe_vertices%value_())
     type is (json_array_t)
-
-      associate(nvertices => vertices%length())
-        allocate(dag%vertices(nvertices))
-        block
-          integer i
-          call dag%vertices%set_vertex_id( [(i,i=1,nvertices)] )
-        end block
-      end associate
-
-      block
-        integer i
-        do i = 1, vertices%length()
-          associate(maybe_vertex => vertices%get_element(i))
-            associate(errors => maybe_vertex%errors())
-              call assert(.not. errors%has_any(), "dag_s construct_from_json: .not. errors%has_any()", char(errors%to_string()))
-            end associate
-
-            select type (vertex_json => maybe_vertex%value_())
-            class default
-              call assert(.false., "dag_s construct_from_json: vertex was not an object", char(vertex_json%to_compact_string()))
-            type is (json_object_t)
-              associate(dag_vertex => vertex_t(vertex_json))
-                call dag%vertices(i)%set_edges(dag_vertex%edges)
-              end associate
-            end select
-          end associate
-        end do
-      end block
+      dag%vertices = vertex_t(vertices%get_elements())
 
     class default
       call assert(.false., "dag%from_json: vertices was not an array", char(vertices%to_compact_string()))
     end select
+    dag%order = toposort(dag)
   end procedure
 
    module procedure to_json
@@ -168,7 +143,7 @@ end function toposort
      block
        type(json_array_t) vertices_value
 
-       vertices_value = json_array_t(json_element_t(self%vertices%to_json())) 
+       vertices_value = json_array_t(json_element_t(self%vertices%to_json()))
 
        associate(vertices_key => maybe_key%string())
          json_object = json_object_t([vertices_key], [json_element_t(vertices_value)])
@@ -190,7 +165,7 @@ end function toposort
 
     allocate(dependencies(0))
 
-    block 
+    block
       integer v
 
       do v = 1, size(self%vertices)
@@ -222,11 +197,11 @@ function generate_digraph(self,rankdir,dpi) result(str)
       !! - Result is the string to write out to a *.dot file. (Called by save_digraph())
       implicit none
       class(dag_t),intent(in)                :: self
-      character(len=:),allocatable         :: str 
+      character(len=:),allocatable         :: str
       character(len=*),intent(in),optional :: rankdir
         !! - Rank Direction which are applicable inputs to the -rankdir option on the digraph command
-      integer,intent(in),optional          :: dpi 
-        !! - dots per inch 
+      integer,intent(in),optional          :: dpi
+        !! - dots per inch
 
       integer :: i,j
       integer :: n_edges

src/vertex_m.f90

@@ -3,7 +3,7 @@ module vertex_m
   !! version: v1.0
   !! date: 2020-Nov-30
   !! license: Copyright (c) 2020-2021, Sourcery Institute, BSD 3-clause license Copyright (c) 2018 Jacob Williams
-    use jsonff, only : json_object_t
+    use jsonff, only : json_element_t, json_object_t, json_value_t
     use iso_varying_string, only : varying_string, len
 
     implicit none
@@ -38,13 +38,19 @@ module vertex_m
     end type vertex_t
 
     interface vertex_t
-      
-      module function from_json(json_object) result(vertex)
+
+      impure elemental module function from_json_element(json_element) result(vertex)
+        implicit none
+        type(json_element_t), intent(in) :: json_element
+        type(vertex_t) :: vertex
+      end function
+
+      module function from_json_value(json_value) result(vertex)
         implicit none
-        type(json_object_t), intent(in) :: json_object
+        class(json_value_t), intent(in) :: json_value
         type(vertex_t) :: vertex
       end function
-  
+
       pure module function construct_from_components(identifier, edges, label, attributes) result(vertex)
         implicit none
         integer, intent(in) :: identifier
@@ -53,11 +59,17 @@ pure module function construct_from_components(identifier, edges, label, attribu
         type(varying_string), intent(in), optional :: attributes
         type(vertex_t) vertex
       end function
-      
+
     end interface
 
     interface
 
+        module function from_json_object(json_object) result(vertex)
+          implicit none
+          type(json_object_t), intent(in) :: json_object
+          type(vertex_t) :: vertex
+        end function
+
        module subroutine set_edge_vector(self,edges)
          !! Define the vertices on which this vertex depends on
          implicit none

src/vertex_s.f90

@@ -3,7 +3,6 @@
       fallible_json_string_t, &
       fallible_json_value_t, &
       json_array_t, &
-      json_element_t, &
       json_number_t, &
       json_string_t, &
       json_integer_t
@@ -27,25 +26,25 @@
     errors = maybe_key%errors()
     call assert(.not. errors%has_any(), "vertex%to_json (edges key): .not. errors%has_any()", char(errors%to_string()))
     edges_key = maybe_key%string()
-    
+
     if (allocated(self%edges)) then
       do i = lbound(self%edges, 1), ubound(self%edges, 1)
         call edges_value%append(json_integer_t(self%edges(i)))
       end do
     end if
-    
+
     maybe_key = fallible_json_string_t("label")
     errors = maybe_key%errors()
     call assert(.not. errors%has_any(), "vertex%to_json (label key): .not. errors%has_any()", char(errors%to_string()))
     label_key = maybe_key%string()
-        
+
     maybe_value = fallible_json_string_t(self%get_label())
     errors = maybe_value%errors()
     call assert(.not. errors%has_any(), "vertex%to_json (label value): .not. errors%has_any()", char(errors%to_string()))
     label_value = maybe_value%string()
 
-    
-    json_object = json_object_t([label_key, edges_key], [json_element_t(label_value), json_element_t(edges_value)])    
+
+    json_object = json_object_t([label_key, edges_key], [json_element_t(label_value), json_element_t(edges_value)])
 
   end procedure
 
@@ -69,7 +68,20 @@
     vertex%defined_ = .true.
   end procedure
 
-  module procedure from_json
+  module procedure from_json_element
+    vertex = vertex_t(json_element%value_())
+  end procedure
+
+  module procedure from_json_value
+    select type (json_value)
+    type is (json_object_t)
+      vertex = from_json_object(json_value)
+    class default
+      call assert(.false., "vertex%from_json_value: vertex was not an object", char(json_value%to_compact_string()))
+    end select
+  end procedure
+
+  module procedure from_json_object
     type(error_list_t) :: errors
     type(fallible_json_value_t) :: maybe_edge
     type(fallible_json_value_t) :: maybe_edges
@@ -88,6 +100,8 @@
         select type (edge => maybe_edge%value_())
         type is (json_number_t)
           vertex%edges(i) = int(edge%get_value())
+        type is (json_integer_t)
+          vertex%edges(i) = edge%get_value()
         class default
           call assert(.false., "vertex%from_json: edge was not a number", char(edge%to_compact_string()))
         end select

test/dag_test.f90

@@ -1,10 +1,11 @@
 module dag_test
   use dag_m, only: dag_t
+  use erloff, only: error_list_t
   use vertex_m, only: vertex_t
   use vegetables, only: &
-      result_t, test_item_t, assert_equals, describe, it, assert_that
+      result_t, test_item_t, assert_equals, describe, it, assert_that, fail
   use iso_varying_string, only : varying_string, var_str, assignment(=), char
-  use jsonff, only: json_object_t
+  use jsonff, only: fallible_json_value_t, json_object_t, parse_json
   !!  Test DAG construction, input, and output.
   implicit none
   private
@@ -16,31 +17,31 @@ function test_dag_construction() result(tests)
     type(test_item_t) :: tests
 
     tests = describe("dag's module dependency graph", &
-      [it("can be constructed, output to .dot file, and converted to a PDF", construct_dag_and_write_pdf) &
-      ,it("can be constructed and converted to a JSON object", construct_dag_and_json_object) &
-      ,it("is topologically sorted when constructed from components", component_constructor_sorts) &
+      [ it("can be constructed, output to .dot file, and converted to a PDF", construct_dag_and_write_pdf) &
+      , it("can be constructed and converted to a JSON object", construct_dag_and_json_object) &
+      , it("is topologically sorted when constructed from components", component_constructor_sorts) &
+      , it("is topologically sorted when constructed from a JSON object", json_constructor_sorts) &
       ])
-      !,it("is topologically sorted when constructed from a JSON object", json_constructor_sorts)])
 
   end function
 
   function module_tree_from_components() result(dag_modules)
     type(dag_t) dag_modules
-    
+
     enum, bind(C)
-      enumerator :: assert_m=1, vertex_s, vertex_m, dag_m, dag_s 
+      enumerator :: assert_m=1, vertex_s, vertex_m, dag_m, dag_s
     end enum
-    
+
     integer, parameter :: module_id(*) = [assert_m,  vertex_s, vertex_m, dag_m, dag_s]
     type(varying_string) :: names(size(module_id))
- 
+
     names(assert_m) = "assert_m"
     names(vertex_m) = "vertex_m"
-    names(vertex_s) = "vertex_s" 
+    names(vertex_s) = "vertex_s"
     names(dag_m)    = "dag_m"
     names(dag_s)    = "dag_s"
 
-    block 
+    block
       character(len=*), parameter :: &
          branch    = 'shape=square, fillcolor="SlateGray1", style=filled' &
         ,external_ = 'shape=square, fillcolor="green",      style=filled' &
@@ -69,7 +70,7 @@ function construct_dag_and_write_pdf() result(result_)
     associate(modules => module_tree_from_components())
       call modules%save_digraph(dot_file_name, 'RL', 300)
       call execute_command_line(command, wait=.true., exitstat=exit_status, cmdstat=command_status)
-      result_ = assert_equals(success, exit_status) .and. assert_equals(success, command_status) 
+      result_ = assert_equals(success, exit_status) .and. assert_equals(success, command_status)
     end associate
 
   end function
@@ -94,28 +95,38 @@ function construct_dag_and_json_object() result(result_)
 
   function component_constructor_sorts() result(result_)
     type(result_t) result_
-    
+
     associate(dag => module_tree_from_components())
       result_ = assert_that(dag%is_sorted_and_acyclic())
     end associate
-  end function 
+  end function
 
   function json_constructor_sorts() result(result_)
     type(result_t) result_
-    type(dag_t) dag 
-    character(len=*), parameter :: dag_library_module_dependencies= &
+    type(dag_t) dag
+    type(error_list_t) :: errors
+    type(fallible_json_value_t) :: maybe_json
+    character(len=*), parameter :: json_string = &
        '{"vertices":[' // &
          '{"label":"assert_m","edges":[]},' // &
          '{"label":"vertex_s","edges":[3,1]},' // &
          '{"label":"vertex_m","edges":[]},' // &
          '{"label":"dag_m","edges":[3]},' // &
          '{"label":"dag_s","edges":[4,1]}]}'
-    character(len=len(dag_library_module_dependencies)) json
-    
-    json = dag_library_module_dependencies
-    
-    read(json,*) dag 
-    result_ = assert_that(dag%is_sorted_and_acyclic())
+
+    maybe_json = parse_json(json_string)
+    if (.not.maybe_json%failed()) then
+      select type (json => maybe_json%value_())
+      type is (json_object_t)
+        dag = dag_t(json)
+        result_ = assert_that(dag%is_sorted_and_acyclic())
+      class default
+        result_ = fail("json wasn't an object")
+      end select
+    else
+      errors = maybe_json%errors()
+      result_ = fail(errors%to_string())
+    end if
   end function
 
 end module dag_test