From 67392555814373aac63979ef8ccd8e2fd1444ae3 Mon Sep 17 00:00:00 2001 From: Andrew Walker Date: Thu, 4 Mar 2021 11:47:23 +0000 Subject: [PATCH 1/2] Move checkFmt to top of file to avoid compiler bug Some versions of gfortran ICE with the function in the body of the file. Defining it first seems to be fine and should be valid Fortran 2008. See https://gcc.gnu.org/bugzilla/show_bug.cgi?id=85138 and https://github.com/andreww/fox/issues/57 --- fsys/fox_m_fsys_format.F90 | 47 +++++++++++++++++++------------------- 1 file changed, 24 insertions(+), 23 deletions(-) diff --git a/fsys/fox_m_fsys_format.F90 b/fsys/fox_m_fsys_format.F90 index 4508cde9..dbf11d37 100644 --- a/fsys/fox_m_fsys_format.F90 +++ b/fsys/fox_m_fsys_format.F90 @@ -123,6 +123,30 @@ module fox_m_fsys_format contains #ifndef DUMMYLIB + ! NB: we need checkFmt at the top of the file + ! to work around a bug in some Gfortran versions + ! see https://gcc.gnu.org/bugzilla/show_bug.cgi?id=85138 + pure function checkFmt(fmt) result(good) + character(len=*), intent(in) :: fmt + logical :: good + + ! should be ([rs]\d*)? + + if (len(fmt) > 0) then + if (fmt(1:1) == "r" .or. fmt(1:1) == "s") then + if (len(fmt) > 1) then + good = (verify(fmt(2:), digit) == 0) + else + good = .true. + endif + else + good = .false. + endif + else + good = .true. + endif + end function checkFmt + ! NB: The len generic module procedure is used in ! many initialisation statments (to set the ! length of the output string needed for the @@ -2216,29 +2240,6 @@ pure function str_complex_dp_matrix(ca) result(s) #endif end function str_complex_dp_matrix -#ifndef DUMMYLIB - pure function checkFmt(fmt) result(good) - character(len=*), intent(in) :: fmt - logical :: good - - ! should be ([rs]\d*)? - - if (len(fmt) > 0) then - if (fmt(1:1) == "r" .or. fmt(1:1) == "s") then - if (len(fmt) > 1) then - good = (verify(fmt(2:), digit) == 0) - else - good = .true. - endif - else - good = .false. - endif - else - good = .true. - endif - end function checkFmt -#endif - pure function concat_str_int(s1, s2) result(s3) character(len=*), intent(in) :: s1 integer, intent(in) :: s2 From 881e6681024d9c06d7384a1646e42428551457b1 Mon Sep 17 00:00:00 2001 From: Andrew Walker Date: Thu, 4 Mar 2021 14:40:34 +0000 Subject: [PATCH 2/2] Move getTextContent_len towards the top of the file Some versions of gfortran ICE with the function in the body of the file. Defining it first seems to be fine and should be valid Fortran 2008. See https://gcc.gnu.org/bugzilla/show_bug.cgi?id=85138 and https://github.com/andreww/fox/issues/57 Do the actual move in the m4 and rebuild (we comit the resulting F90 files so users don't need an m4 implementation to build FoX). At the same time propogate a couple of changes from the F90 back into other m4 files so we don't loose those changes. --- dom/m_dom_dom.F90 | 25 +++++++++++++------------ dom/m_dom_element.m4 | 3 ++- dom/m_dom_node.m4 | 24 ++++++++++++------------ dom/m_dom_types.m4 | 6 +++--- 4 files changed, 30 insertions(+), 28 deletions(-) diff --git a/dom/m_dom_dom.F90 b/dom/m_dom_dom.F90 index 0d724d8f..3adeb041 100644 --- a/dom/m_dom_dom.F90 +++ b/dom/m_dom_dom.F90 @@ -997,6 +997,18 @@ function getnodeName(np, ex)result(c) end function getnodeName + pure function getTextContent_len(arg, p) result(n) + type(Node), intent(in) :: arg + logical, intent(in) :: p + integer :: n + + if (p) then + n = arg%textContentLength + else + n = 0 + endif + end function getTextContent_len + pure function getNodeValue_len(np, p) result(n) type(Node), intent(in) :: np logical, intent(in) :: p @@ -4053,18 +4065,6 @@ subroutine updateTextContentLength(np, n) endif end subroutine updateTextContentLength - pure function getTextContent_len(arg, p) result(n) - type(Node), intent(in) :: arg - logical, intent(in) :: p - integer :: n - - if (p) then - n = arg%textContentLength - else - n = 0 - endif - end function getTextContent_len - function getTextContent(arg, ex)result(c) type(DOMException), intent(out), optional :: ex type(Node), pointer :: arg @@ -5847,6 +5847,7 @@ subroutine destroyDocument(arg, ex) ! Switch off all GC - since this is GC! call setGCstate(arg, .false., ex) + if (arg%nodeType/=DOCUMENT_NODE) then if (getFoX_checks().or.FoX_INVALID_NODE<200) then call throw_exception(FoX_INVALID_NODE, "destroyDocument", ex) diff --git a/dom/m_dom_element.m4 b/dom/m_dom_element.m4 index e2518428..9239aa0e 100644 --- a/dom/m_dom_element.m4 +++ b/dom/m_dom_element.m4 @@ -340,7 +340,8 @@ TOHW_m_dom_get(DOMString, tagName, np%nodeName, (ELEMENT_NODE)) endif endif -! FIXME what if namespace is undeclared? Throw an error *only* if FoX_errors is on, otherwise its taken care of by namespace fixup on serialization +! FIXME what if namespace is undeclared? Throw an error *only* if FoX_errors is +! on, otherwise its taken care of by namespace fixup on serialization quickFix = getGCstate(getOwnerDocument(arg)) & .and. arg%inDocument diff --git a/dom/m_dom_node.m4 b/dom/m_dom_node.m4 index 106efcfe..fed8d480 100644 --- a/dom/m_dom_node.m4 +++ b/dom/m_dom_node.m4 @@ -47,6 +47,18 @@ TOHW_m_dom_contents(` TOHW_m_dom_get(DOMString, nodeName, np%nodeName) + pure function getTextContent_len(arg, p) result(n) + type(Node), intent(in) :: arg + logical, intent(in) :: p + integer :: n + + if (p) then + n = arg%textContentLength + else + n = 0 + endif + end function getTextContent_len + pure function getNodeValue_len(np, p) result(n) type(Node), intent(in) :: np logical, intent(in) :: p @@ -1332,18 +1344,6 @@ TOHW_m_dom_treewalk(` endif end subroutine updateTextContentLength - pure function getTextContent_len(arg, p) result(n) - type(Node), intent(in) :: arg - logical, intent(in) :: p - integer :: n - - if (p) then - n = arg%textContentLength - else - n = 0 - endif - end function getTextContent_len - TOHW_function(getTextContent, (arg), c) type(Node), pointer :: arg #ifdef RESTRICTED_ASSOCIATED_BUG diff --git a/dom/m_dom_types.m4 b/dom/m_dom_types.m4 index 18b0dcfc..bd2afb6b 100644 --- a/dom/m_dom_types.m4 +++ b/dom/m_dom_types.m4 @@ -169,11 +169,11 @@ TOHW_m_dom_contents(` select case(np%nodeType) case (ELEMENT_NODE, ATTRIBUTE_NODE, XPATH_NAMESPACE_NODE) - call destroyElementOrAttribute(np,ex) + call destroyElementOrAttribute(np, ex) case (DOCUMENT_TYPE_NODE) - call destroyDocumentType(np,ex) + call destroyDocumentType(np, ex) case (ENTITY_NODE, NOTATION_NODE) - call destroyEntityOrNotation(np,ex) + call destroyEntityOrNotation(np, ex) case (DOCUMENT_NODE) call destroyDocument(np,ex) end select