text:
program main
  use iso_c_binding

  implicit none

  block
    use posix

    character(:), allocatable, target :: name, message, mode
    integer(c_int) :: res
    integer(c_long) :: long_res
    integer(c_size_t) :: size_res
    type(c_ptr) :: cptr

    cptr = posix_malloc(10_c_size_t)
    call posix_free(cptr)

    name = "foo" // c_null_char
    res = posix_mkdir(c_loc(name), int(o"700"))
    print *, "posix_mkdir", res
    res = posix_rmdir(c_loc(name))
    print *, "posix_rmdir", res

    name = "Makefile" // c_null_char
    res = posix_access(c_loc(name), posix_f_ok)
    print *, "posix_access", res

    mode = "r" // c_null_char
    cptr = posix_fopen(c_loc(name), c_loc(mode))
    res = posix_fseek(cptr, 0_c_long, posix_seek_end)
    long_res = posix_ftell(cptr)
    print *, "posix_ftell", long_res

    call posix_rewind(cptr)
    res = posix_fclose(cptr)
    print *, "posix_fclose", res

    if (posix_mkdir(c_loc(name), int(o"700")) == -1) then
       message = "mkdir: " // char(0)
       call posix_perror(c_loc(message))
    end if

    name = "foo.txt" // c_null_char
    res = posix_unlink(c_loc(name))
    print *, "posix_unlink", res

    message = "message" // achar(10)
    size_res = posix_write(2, c_loc(message), 8_c_size_t)
    print *, "posix_write", size_res

    message = "message" // achar(10) // char(0)
    size_res = posix_strlen(c_loc(message))
    print *, "posix_strlen", size_res
  end block
end program main

max_stars_repo_name: dram/fortran-posix

max_issues_repo_name: dram/fortran-posix

max_forks_repo_name: dram/fortran-posix


text:
C  *********************************************************
C  *                                                       *
C  *    TEST NUMBER: 04.02.05.03/02                        *
C  *    TEST TITLE : Setting entries of various kinds      *
C  *                                                       *
C  *    PHIGS Validation Tests, produced by NIST           *
C  *                                                       *
C  *********************************************************

      COMMON /GLOBNU/ CTLHND, ERRSIG, ERRFIL, IERRCT, UNERR,
     1        TESTCT, IFLERR, PASSSW, ERRSW, MAXLIN,
     2        CONID, MEMUN, WKID, WTYPE, GLBLUN, INDLUN,
     3        DUMINT, DUMRL
      INTEGER         CTLHND, ERRSIG, ERRFIL, IERRCT, UNERR,
     1        TESTCT, IFLERR, PASSSW, ERRSW, MAXLIN,
     2        CONID, MEMUN, WKID, WTYPE, GLBLUN, INDLUN,
     3        DUMINT(20), ERRIND
      REAL    DUMRL(20)

      COMMON /GLOBCH/ PIDENT,    GLBERR,    TSTMSG,     FUNCID,
     1                DUMCH
      CHARACTER       PIDENT*40, GLBERR*60, TSTMSG*900, FUNCID*80,
     1                DUMCH(20)*20

      INTEGER    MAXED
C define a number greater than the number of initialized edge entries
      PARAMETER (MAXED=300)

C PHIGS parameter types
      INTEGER    MEDBTE, IDUM1, IDUM2, IDUM3, IDUM4, IDUM5, IDUM6,
     1           IDUM7
      INTEGER    EDI, EFLAG, ETYPE, COLI, EFLAG2, ETYPE2, COLI2

C type of returned value
      INTEGER    PSET,     PREALI
      PARAMETER (PSET = 0, PREALI = 1)

C off/on switch for edge flag and error handling mode
      INTEGER    POFF,     PON
      PARAMETER (POFF = 0, PON = 1)

      REAL       EWDTH, EWDTH2, RDUM1, RDUM2, RDUM3
C used to control tests
      INTEGER    MNE, NIE, AII, LISTEL, LISTOT, DEFI(MAXED)
      INTEGER    LUI, DEI, CNDE, NNDE, NAET, AVET

C parameters for <inquire workstation connection and type>
      INTEGER    SPECWT, SPECON

      DATA DEFI / MAXED*0 /

      CALL INITGL ('04.02.05.03/02')

C open PHIGS
      CALL XPOPPH (ERRFIL, MEMUN)
C open workstation
      CALL POPWK  (WKID, CONID, WTYPE)
      CALL PQWKC  (WKID, ERRIND, SPECON, SPECWT)
      CALL CHKINQ ('pqwkc', ERRIND)

      CALL PQWKSL (SPECWT, ERRIND, IDUM1, IDUM2, IDUM3, IDUM4,
     1             MEDBTE, IDUM5, IDUM6, IDUM7)
      CALL CHKINQ ('pqwksl', ERRIND)

C maximum number of edge bundle table entries
      MNE = MEDBTE

C *** *** *** *** ***    initialized entries   *** *** *** *** ***

C There should be at least 5 initialized edge bundles - this
C inquiry gets the first, so it should work.  This statement
C is NOT meant to test the requirement of 5 initialized bundles;
C that is done elsewhere.

      CALL SETMSG ('12', '<Inquire list of edge indices> should ' //
     1             'return initialized indices.')
C   nie = number of initialized edge entries
C   aii = an initialized index (the first)
      CALL PQEEDI (WKID, 1, ERRIND, NIE, AII)
      IF (ERRIND .NE. 0) THEN
         CALL FAIL
         GOTO 200
      ELSE
         CALL PASS
      ENDIF

C get initialized attributes
      CALL PQEDR (WKID, AII, PSET, ERRIND, EFLAG, ETYPE, EWDTH, COLI)
      CALL CHKINQ ('pqedr', ERRIND)

C set different values for attributes

C make sure edgeflag is valid
      IF (EFLAG .EQ. PON) THEN
          EFLAG2 = POFF
      ELSE
          EFLAG2 = PON
      ENDIF

C  get an available edgetype
      CALL PQEDF (SPECWT, 0,    ERRIND, NAET,  IDUM1, IDUM2,
     1            RDUM1, RDUM2, RDUM3, IDUM3)
      CALL CHKINQ ('pqedf', ERRIND)
      CALL PQEDF (SPECWT, (NAET+1)/2, ERRIND, IDUM1, AVET, IDUM2,
     1            RDUM1, RDUM2, RDUM3, IDUM3)
      CALL CHKINQ ('pqedf', ERRIND)

      IF (ETYPE .NE. 1) THEN
         ETYPE2 = 1
      ELSE
         ETYPE2 = AVET
      ENDIF

      EWDTH2 = EWDTH * 1.5
      COLI2  = COLI + 1
      CALL PSEDR (WKID, AII, EFLAG2, ETYPE2, EWDTH2, COLI2)

C get current number of defined entries
      CALL PQEEDI (WKID, 0, ERRIND, CNDE, IDUM1)
      CALL CHKINQ ('pqeedi', ERRIND)

      CALL SETMSG ('10 12', 'Re-defining a system-initialized entry ' //
     1             'should not change the number of defined entries.')
      CALL IFPF (CNDE .EQ. NIE)

C check that aii is still among defined entries
      CALL SETMSG ('10 12', 'Initialized bundle entry should be ' //
     1             'reported as defined after being set.')

      DO 150 LISTEL = 1, CNDE
         CALL PQEEDI (WKID, LISTEL, ERRIND, IDUM1, EDI)
         CALL CHKINQ ('pqeedi', ERRIND)
         IF (EDI .EQ. AII) THEN
            CALL PASS
            GOTO 160
         ENDIF
150   CONTINUE
      CALL FAIL
      GOTO 200
160   CONTINUE

      CALL PQEDR (WKID, AII, PSET, ERRIND, EFLAG, ETYPE, EWDTH, COLI)
      CALL CHKINQ ('pqedr', ERRIND)
      CALL SETMSG ('11 14', 'New values should be set for ' //
     1             'initialized bundle entry.')

      CALL IFPF (EFLAG .EQ. EFLAG2 .AND.
     1           ETYPE .EQ. ETYPE2 .AND.
     2           EWDTH .EQ. EWDTH2 .AND.
     3           COLI  .EQ. COLI2)

C *** *** *** *** ***    undefined entries   *** *** *** *** ***
200   CONTINUE

C get lowest undefined index
C get current number defined entries
      CALL PQEEDI (WKID, 0, ERRIND, CNDE, IDUM1)
      CALL CHKINQ ('pqeedi', ERRIND)
C defi is originally an array of zeros
      DO 250 LISTEL = 1, CNDE
         CALL PQEEDI (WKID, LISTEL, ERRIND, IDUM1, EDI)
         CALL CHKINQ ('pqeedi', ERRIND)
C mark as defined any index .le. cnde+1
C This will leave at least one UNmarked.
         IF (EDI .LE. CNDE+1) DEFI (EDI) = 1
250   CONTINUE

C first remaining zero indicates undefined entry
      DO 260 EDI = 1, CNDE+1
         IF (DEFI (EDI) .EQ. 0) THEN
C determine lowest undefined index (not in defined list) = lui
            LUI = EDI
            GOTO 270
         ENDIF
260   CONTINUE
      CALL UNMSG
     1     ('Cannot find undefined index - error in test algorithm.')

C established lui as lowest undefined index
270   CONTINUE
      CALL SETMSG ('12 15 16', '<Inquire edge representation> '   //
     1             'should return attributes for bundle #1 when ' //
     2             'inquiring an undefined entry as REALIZED.')

C inquire undefined bundle as REALIZED
      CALL PQEDR  (WKID, LUI, PREALI, ERRIND, EFLAG, ETYPE,
     1             EWDTH,  COLI)
      CALL CHKINQ ('pqedr', ERRIND)
C inquire bundle #1 as REALIZED
      CALL PQEDR  (WKID, 1, PREALI, ERRIND, EFLAG2, ETYPE2,
     1             EWDTH2, COLI2)
      CALL CHKINQ ('pqedr', ERRIND)
C should have same attributes
      CALL IFPF (EFLAG .EQ. EFLAG2 .AND.
     1           ETYPE .EQ. ETYPE2 .AND.
     2           EWDTH .EQ. EWDTH2 .AND.
     3           COLI  .EQ. COLI2)

C  If number of initialized entries >= implementation max then skip test
C  of setting undefined entry - goto redefined_test.
      IF (NIE .GE. MNE) THEN
         CALL INMSG ('Skipping undefined-test because all edge ' //
     1               'entries are initialized.')
         GOTO 300
      ENDIF

C Check that program allows enough room
      IF (NIE .GE. MAXED) THEN
         CALL INMSG ('Skipping undefined-test because number of ' //
     1               'initialized entries exceed program limits.')
         GOTO 300
      ENDIF

C set values for attributes
      EFLAG2 = POFF
      ETYPE2 = 3
      EWDTH2 = 4.0
      COLI2  = 5
      CALL PSEDR (WKID, LUI, EFLAG2, ETYPE2, EWDTH2, COLI2)

      CALL PQEEDI (WKID, 0, ERRIND, LISTOT, IDUM1)
      CALL CHKINQ ('pqeedi', ERRIND)

      CALL SETMSG ('10 12', 'Defining an undefined entry should ' //
     1             'increment the number of defined entries.')
      CALL IFPF (LISTOT .EQ. CNDE + 1)

C check that lui is now among defined entries
      CALL SETMSG ('10 12', 'Undefined bundle entry should be ' //
     1             'reported as defined after set.')
      DO 280 LISTEL = 1, LISTOT
         CALL PQEEDI (WKID, LISTEL, ERRIND, IDUM1, EDI)
         CALL CHKINQ ('pqeedi', ERRIND)
         IF (EDI .EQ. LUI) THEN
            CALL PASS
            GOTO 290
         ENDIF
280   CONTINUE
      CALL FAIL
      GOTO 300
290   CONTINUE

      CALL PQEDR (WKID, LUI, PSET, ERRIND, EFLAG, ETYPE, EWDTH, COLI)
      CALL CHKINQ ('pqedr', ERRIND)
      CALL SETMSG ('11 14', 'New values should be set for ' //
     1             'undefined bundle entry.')
      CALL IFPF (EFLAG .EQ. EFLAG2 .AND.
     1           ETYPE .EQ. ETYPE2 .AND.
     2           EWDTH .EQ. EWDTH2 .AND.
     3           COLI  .EQ. COLI2)

C *** *** *** *** ***    redefined entries   *** *** *** *** ***
300   CONTINUE

C get current number defined entries
      CALL PQEEDI (WKID, 0, ERRIND, CNDE, IDUM1)
      CALL CHKINQ ('pqeedi', ERRIND)

C let dei = a defined edge index from middle of list
      CALL PQEEDI (WKID, (CNDE+1)/2, ERRIND, IDUM1, DEI)
      CALL CHKINQ ('pqeedi', ERRIND)

C set to first set of values
      CALL PQEDF (SPECWT, (NAET+1)/2, ERRIND, IDUM1, ETYPE, IDUM2,
     1            RDUM1, RDUM2, RDUM3, IDUM3)
      CALL CHKINQ ('pqedf', ERRIND)
      EFLAG = PON
      EWDTH = 3.0
      COLI  = 4
      CALL PSEDR (WKID, DEI, EFLAG, ETYPE, EWDTH, COLI)
C re-set to different values
      CALL PQEDF (SPECWT, NAET, ERRIND, IDUM1, ETYPE2, IDUM2,
     1            RDUM1, RDUM2, RDUM3, IDUM3)
      CALL CHKINQ ('pqedf', ERRIND)
      EFLAG2 = POFF
      EWDTH2 = 4.0
      COLI2  = 5
      CALL PSEDR (WKID, DEI, EFLAG2, ETYPE2, EWDTH2, COLI2)

C get list size - nnde = new number of defined entries
      CALL PQEEDI (WKID, 0, ERRIND, NNDE, IDUM1)
      CALL CHKINQ ('pqeedi', ERRIND)

      CALL SETMSG ('10 12', 'Re-defining a user-defined entry ' //
     1             'should not change number of defined entries.')
      CALL IFPF (NNDE .EQ. CNDE)

C check that dei is among defined entries
      CALL SETMSG ('10 12', 'Redefined bundle entry should be ' //
     1             'reported as defined after set.')
      DO 320 LISTEL = 1, NNDE
         CALL PQEEDI (WKID, LISTEL, ERRIND, IDUM1, EDI)
         CALL CHKINQ ('pqeedi', ERRIND)
         IF (EDI .EQ. DEI) THEN
            CALL PASS
            GOTO 330
         ENDIF
320   CONTINUE
      CALL FAIL
      GOTO 399
330   CONTINUE

      CALL PQEDR (WKID, DEI, PSET, ERRIND, EFLAG, ETYPE, EWDTH, COLI)
      CALL CHKINQ ('pqedr', ERRIND)
      CALL SETMSG ('11 14', 'New values should be set for ' //
     1             'redefined bundle entry.')
      CALL IFPF (EFLAG .EQ. EFLAG2 .AND.
     1           ETYPE .EQ. ETYPE2 .AND.
     2           EWDTH .EQ. EWDTH2 .AND.
     3           COLI  .EQ. COLI2)

399   CONTINUE

C *** *** *** ***   access all defined entries   *** *** *** ***

      CALL SETMSG ('12 13', '<Inquire list of edge indices> and ' //
     1             '<inquire edge representation> should detect ' //
     2             'all defined entries.')
C get listel-th element of defined edge indices
      DO 410 LISTEL = 1, NNDE
         CALL PQEEDI (WKID, LISTEL, ERRIND, IDUM1, EDI)
         IF (ERRIND .NE. 0) THEN
            CALL FAIL
            GOTO 415
         ENDIF
         CALL PQEDR (WKID, EDI, PSET, ERRIND, EFLAG, ETYPE, EWDTH,
     1               COLI)
         IF (ERRIND .NE. 0) THEN
            CALL FAIL
            GOTO 415
         ENDIF
410   CONTINUE
      CALL PASS
415   CONTINUE

666   CONTINUE
      CALL ENDIT
      END

ext: f


! { dg-do compile }
!
! Test the fix for PR79402, in which the module procedure 'fun1' picked
! up a spurious symbol for the dummy 'n' in the specification expression
! for the result 'y'.
!
! Contributed by Chris Coutinho  <chrisbcoutinho@gmail.com>
!
module mod
  interface myfun
    module function fun1(n) result(y)
      integer,  intent(in)    :: n
      real, dimension(n)  :: y
    end function fun1
  end interface myfun

end module mod

submodule (mod) submod
contains
  module procedure fun1
    integer :: i
    y = [(float (i), i = 1, n)]
  end procedure fun1
end submodule

  use mod
  print *, fun1(10)
end


text:
module quaff_angle_m
    use erloff, only: error_list_t, fatal_t, module_t, procedure_t
    use iso_varying_string, only: &
            varying_string, &
            assignment(=), &
            operator(==), &
            operator(//), &
            var_str
    use parff, only: &
            parse_result_t, &
            parsed_rational_t, &
            parser_output_t, &
            state_t, &
            either, &
            parse_end_of_input, &
            parse_rational, &
            parse_string, &
            parse_whitespace, &
            parse_with, &
            then_drop
    use quaff_conversion_factors_m, only: DEGREES_PER_RADIAN
    use quaff_utilities_m, only: &
            operator(.safeEq.), &
            equal_within_absolute, &
            equal_within_relative, &
            parse_space, &
            PARSE_ERROR, &
            UNKNOWN_UNIT
    use strff, only: join, to_string

    implicit none
    private
    public :: &
            angle_t, &
            fallible_angle_t, &
            angle_unit_t, &
            fallible_angle_unit_t, &
            angle_simple_unit_t, &
            operator(.unit.), &
            parse_angle, &
            parse_angle_unit, &
            sum, &
            abs, &
            sin, &
            cos, &
            tan, &
            asin_, &
            acos_, &
            atan_, &
            atan2_, &
            DEFAULT_OUTPUT_UNITS, &
            PROVIDED_UNITS, &
            DEGREES, &
            RADIANS

    type :: angle_t
        double precision :: radians
    contains
        private
        procedure :: to_units
        generic, public :: operator(.in.) => to_units
        procedure, pass(angle) :: double_times_angle
        procedure, pass(angle) :: integer_times_angle
        procedure :: angle_times_double
        procedure :: angle_times_integer
        generic, public :: operator(*) => &
                double_times_angle, &
                integer_times_angle, &
                angle_times_double, &
                angle_times_integer
        procedure :: angle_divided_by_double
        procedure :: angle_divided_by_integer
        procedure :: angle_divided_by_angle
        generic, public :: operator(/) => &
                angle_divided_by_double, &
                angle_divided_by_integer, &
                angle_divided_by_angle
        procedure :: angle_plus_angle
        generic, public :: operator(+) => angle_plus_angle
        procedure :: angle_minus_angle
        generic, public :: operator(-) => angle_minus_angle
        procedure :: greater_than
        generic, public :: operator(>) => greater_than
        procedure :: less_than
        generic, public :: operator(<) => less_than
        procedure :: greater_than_or_equal
        generic, public :: operator(>=) => greater_than_or_equal
        procedure :: less_than_or_equal
        generic, public :: operator(<=) => less_than_or_equal
        procedure :: equal_
        generic, public :: operator(==) => equal_
        procedure :: equal_within_absolute_
        procedure :: equal_within_relative_
        generic, public :: equal => &
                equal_, equal_within_absolute_, equal_within_relative_
        procedure :: not_equal
        generic, public :: operator(/=) => not_equal
        procedure :: to_string_full_precision
        procedure :: to_string_with_precision
        generic, public :: to_string => &
                to_string_full_precision, to_string_with_precision
        procedure :: to_string_in_full_precision
        procedure :: to_string_in_with_precision
        generic, public :: to_string_in => &
                to_string_in_full_precision, to_string_in_with_precision
    end type

    type :: fallible_angle_t
        private
        type(angle_t) :: angle_ = angle_t(0.0d0)
        type(error_list_t) :: errors_
    contains
        private
        procedure, public :: failed => fallible_angle_failed
        procedure, public :: angle => fallible_angle_angle
        procedure, public :: errors => fallible_angle_errors
    end type

    type, abstract :: angle_unit_t
        double precision :: conversion_factor
    contains
        procedure(unit_to_string_i), deferred :: unit_to_string
        procedure(value_to_string_i), deferred :: value_to_string
        generic :: to_string => unit_to_string, value_to_string
        procedure(parse_as_i), deferred :: parse_as
    end type

    type :: fallible_angle_unit_t
        private
        class(angle_unit_t), allocatable :: unit_
        type(error_list_t) :: errors_
    contains
        private
        procedure, public :: failed => fallible_angle_unit_failed
        procedure, public :: unit => fallible_angle_unit_unit
        procedure, public :: errors => fallible_angle_unit_errors
    end type

    type, extends(angle_unit_t) :: angle_simple_unit_t
        character(len=20) :: symbol
    contains
        procedure :: unit_to_string => simple_unit_to_string
        procedure :: value_to_string => simple_value_to_string
        procedure :: parse_as => simple_parse_as
    end type

    abstract interface
        elemental function unit_to_string_i(self) result(string)
            import :: angle_unit_t, varying_string

            implicit none

            class(angle_unit_t), intent(in) :: self
            type(varying_string) :: string
        end function

        pure function value_to_string_i(self, value_) result(string)
            import :: angle_unit_t, varying_string

            implicit none

            class(angle_unit_t), intent(in) :: self
            type(varying_string), intent(in) :: value_
            type(varying_string) :: string
        end function

        function parse_as_i(self, string) result(fallible_angle)
            import :: angle_unit_t, fallible_angle_t, varying_string

            implicit none

            class(angle_unit_t), intent(in) :: self
            type(varying_string), intent(in) :: string
            type(fallible_angle_t) :: fallible_angle
        end function
    end interface

    interface operator(.unit.)
        module procedure from_units
    end interface

    interface fallible_angle_t
        module procedure fallible_angle_from_angle
        module procedure fallible_angle_from_errors
        module procedure fallible_angle_from_fallible_angle
    end interface

    interface fallible_angle_unit_t
        module procedure fallible_angle_unit_from_unit
        module procedure fallible_angle_unit_from_errors
        module procedure fallible_angle_unit_from_fallible_angle_unit
    end interface

    interface parse_angle
        module procedure parse_angle_c
        module procedure parse_angle_s
        module procedure parse_angle_with_units_c
        module procedure parse_angle_with_units_s
    end interface

    interface parse_angle_unit
        module procedure parse_angle_unit_c
        module procedure parse_angle_unit_s
        module procedure parse_angle_unit_with_units_c
        module procedure parse_angle_unit_with_units_s
    end interface

    interface abs
          module procedure abs_angle
    end interface

    interface sum
        module procedure sum_angle
    end interface

    interface sin
        module procedure sin_
    end interface

    interface cos
        module procedure cos_
    end interface

    interface tan
        module procedure tan_
    end interface

    type(angle_simple_unit_t), parameter :: DEGREES = &
            angle_simple_unit_t( &
                    conversion_factor = DEGREES_PER_RADIAN, &
                    symbol = "deg")
    type(angle_simple_unit_t), parameter :: RADIANS = &
            angle_simple_unit_t( &
                    conversion_factor = 1.0d0, &
                    symbol = "rad")

    type(angle_simple_unit_t) :: DEFAULT_OUTPUT_UNITS = RADIANS

    type(angle_simple_unit_t), parameter :: PROVIDED_UNITS(*) = &
            [DEGREES, RADIANS]

    character(len=*), parameter :: MODULE_NAME = "quaff_angle_m"
contains
    function parse_angle_c(string) result(fallible_angle)
        character(len=*), intent(in) :: string
        type(fallible_angle_t) :: fallible_angle

        fallible_angle = fallible_angle_t( &
                parse_angle(var_str(string), PROVIDED_UNITS), &
                module_t(MODULE_NAME), &
                procedure_t("parse_angle_c"))
    end function

    function parse_angle_s(string) result(fallible_angle)
        type(varying_string), intent(in) :: string
        type(fallible_angle_t) :: fallible_angle

        fallible_angle = fallible_angle_t( &
                parse_angle(string, PROVIDED_UNITS), &
                module_t(MODULE_NAME), &
                procedure_t("parse_angle_s"))
    end function

    function parse_angle_with_units_c( &
            string, units) result(fallible_angle)
        character(len=*), intent(in) :: string
        class(angle_unit_t), intent(in) :: units(:)
        type(fallible_angle_t) :: fallible_angle

        fallible_angle = fallible_angle_t( &
                parse_angle(var_str(string), units), &
                module_t(MODULE_NAME), &
                procedure_t("parse_angle_with_units_c"))
    end function

    function parse_angle_with_units_s( &
            string, units) result(fallible_angle)
        type(varying_string), intent(in) :: string
        class(angle_unit_t), intent(in) :: units(:)
        type(fallible_angle_t) :: fallible_angle

        integer :: i

        do i = 1, size(units)
            fallible_angle = units(i)%parse_as(string)
            if (.not. fallible_angle%failed()) return
        end do
        fallible_angle = fallible_angle_t(error_list_t(fatal_t( &
                PARSE_ERROR, &
                module_t(MODULE_NAME), &
                procedure_t("parse_angle_with_units_s"), &
                "Unable to parse '" // string // "' as a angle_t. Tried with units: " &
                // join(units%to_string(), ", "))))
    end function

    elemental function from_units(value_, units) result(angle)
        double precision, intent(in) :: value_
        class(angle_unit_t), intent(in) :: units
        type(angle_t) :: angle

        angle%radians = value_ / units%conversion_factor
    end function

    elemental function to_units(self, units) result(angle)
        class(angle_t), intent(in) :: self
        class(angle_unit_t), intent(in) :: units
        double precision :: angle

        angle = self%radians * units%conversion_factor
    end function

    elemental function double_times_angle( &
            multiplier, angle) result(new_angle)
        double precision, intent(in) :: multiplier
        class(angle_t), intent(in) :: angle
        type(angle_t) :: new_angle

        new_angle%radians = &
                multiplier * angle%radians
    end function

    elemental function integer_times_angle( &
            multiplier, angle) result(new_angle)
        integer, intent(in) :: multiplier
        class(angle_t), intent(in) :: angle
        type(angle_t) :: new_angle

        new_angle%radians = &
                dble(multiplier) * angle%radians
    end function

    elemental function angle_times_double( &
            angle, multiplier) result(new_angle)
        class(angle_t), intent(in) :: angle
        double precision, intent(in) :: multiplier
        type(angle_t) :: new_angle

        new_angle%radians = &
                angle%radians * multiplier
    end function

    elemental function angle_times_integer( &
            angle, multiplier) result(new_angle)
        class(angle_t), intent(in) :: angle
        integer, intent(in) :: multiplier
        type(angle_t) :: new_angle

        new_angle%radians = &
                angle%radians * dble(multiplier)
    end function

    elemental function angle_divided_by_double( &
            angle, divisor) result(new_angle)
        class(angle_t), intent(in) :: angle
        double precision, intent(in) :: divisor
        type(angle_t) :: new_angle

        new_angle%radians = &
                angle%radians / divisor
    end function

    elemental function angle_divided_by_integer( &
            angle, divisor) result(new_angle)
        class(angle_t), intent(in) :: angle
        integer, intent(in) :: divisor
        type(angle_t) :: new_angle

        new_angle%radians = &
                angle%radians / dble(divisor)
    end function

    elemental function angle_divided_by_angle( &
            numerator, denomenator) result(ratio)
        class(angle_t), intent(in) :: numerator
        type(angle_t), intent(in) :: denomenator
        double precision :: ratio

        ratio = numerator%radians / denomenator%radians
    end function

    elemental function angle_plus_angle( &
            lhs, rhs) result(sum_)
        class(angle_t), intent(in) :: lhs
        type(angle_t), intent(in) :: rhs
        type(angle_t) :: sum_

        sum_%radians = lhs%radians + rhs%radians
    end function

    elemental function angle_minus_angle( &
            lhs, rhs) result(difference)
        class(angle_t), intent(in) :: lhs
        type(angle_t), intent(in) :: rhs
        type(angle_t) :: difference

        difference%radians = lhs%radians - rhs%radians
    end function

    pure function abs_angle(angle) result(abs_)
        class(angle_t), intent(in) :: angle
        type(angle_t) :: abs_

        abs_%radians = abs(angle%radians)
    end function

    pure function sum_angle(angles) result(sum_)
        type(angle_t), intent(in) :: angles(:)
        type(angle_t) :: sum_

        sum_%radians = sum(angles%radians)
    end function

    elemental function greater_than(lhs, rhs)
        class(angle_t), intent(in) :: lhs
        type(angle_t), intent(in) :: rhs
        logical :: greater_than

        greater_than = lhs%radians > rhs%radians
    end function

    elemental function less_than(lhs, rhs)
        class(angle_t), intent(in) :: lhs
        type(angle_t), intent(in) :: rhs
        logical :: less_than

        less_than = lhs%radians < rhs%radians
    end function

    elemental function greater_than_or_equal(lhs, rhs)
        class(angle_t), intent(in) :: lhs
        type(angle_t), intent(in) :: rhs
        logical :: greater_than_or_equal

        greater_than_or_equal = lhs%radians >= rhs%radians
    end function

    elemental function less_than_or_equal(lhs, rhs)
        class(angle_t), intent(in) :: lhs
        type(angle_t), intent(in) :: rhs
        logical :: less_than_or_equal

        less_than_or_equal = lhs%radians <= rhs%radians
    end function

    elemental function equal_(lhs, rhs)
        class(angle_t), intent(in) :: lhs
        type(angle_t), intent(in) :: rhs
        logical :: equal_

        equal_ = lhs%radians .safeEq. rhs%radians
    end function

    elemental function equal_within_absolute_(lhs, rhs, within)
        class(angle_t), intent(in) :: lhs
        type(angle_t), intent(in) :: rhs
        type(angle_t), intent(in) :: within
        logical :: equal_within_absolute_

        equal_within_absolute_ = equal_within_absolute( &
                lhs%radians, rhs%radians, within%radians)
    end function

    elemental function equal_within_relative_(lhs, rhs, within)
        class(angle_t), intent(in) :: lhs
        type(angle_t), intent(in) :: rhs
        double precision, intent(in) :: within
        logical :: equal_within_relative_

        equal_within_relative_ = equal_within_relative( &
                lhs%radians, rhs%radians, within)
    end function

    elemental function not_equal(lhs, rhs)
        class(angle_t), intent(in) :: lhs
        type(angle_t), intent(in) :: rhs
        logical :: not_equal

        not_equal = .not. lhs == rhs
    end function

    elemental function to_string_full_precision(self) result(string)
        class(angle_t), intent(in) :: self
        type(varying_string) :: string

        string = self%to_string_in(DEFAULT_OUTPUT_UNITS)
    end function

    elemental function to_string_with_precision(self, significant_digits) result(string)
        class(angle_t), intent(in) :: self
        integer, intent(in) :: significant_digits
        type(varying_string) :: string

        string = self%to_string_in(DEFAULT_OUTPUT_UNITS, significant_digits)
    end function

    elemental function to_string_in_full_precision(self, units) result(string)
        class(angle_t), intent(in) :: self
        class(angle_unit_t), intent(in) :: units
        type(varying_string) :: string

        string = units%to_string(to_string(self.in.units))
    end function

    elemental function to_string_in_with_precision( &
            self, units, significant_digits) result(string)
        class(angle_t), intent(in) :: self
        class(angle_unit_t), intent(in) :: units
        integer, intent(in) :: significant_digits
        type(varying_string) :: string

        string = units%to_string(to_string(self.in.units, significant_digits))
    end function

    function fallible_angle_from_angle( &
            angle) result(fallible_angle)
        type(angle_t), intent(in) :: angle
        type(fallible_angle_t) :: fallible_angle

        fallible_angle%angle_ = angle
    end function

    function fallible_angle_from_errors( &
            errors) result(fallible_angle)
        type(error_list_t), intent(in) :: errors
        type(fallible_angle_t) :: fallible_angle

        fallible_angle%errors_ = errors
    end function

    function fallible_angle_from_fallible_angle( &
            fallible_angle, &
            module_, &
            procedure_) &
            result(new_fallible_angle)
        type(fallible_angle_t), intent(in) :: fallible_angle
        type(module_t), intent(in) :: module_
        type(procedure_t), intent(in) :: procedure_
        type(fallible_angle_t) :: new_fallible_angle

        if (fallible_angle%failed()) then
            new_fallible_angle%errors_ = error_list_t( &
                    fallible_angle%errors_, module_, procedure_)
        else
            new_fallible_angle%angle_ = fallible_angle%angle_
        end if
    end function

    elemental function fallible_angle_failed( &
            self) result(failed)
        class(fallible_angle_t), intent(in) :: self
        logical :: failed

        failed = self%errors_%has_any()
    end function

    elemental function fallible_angle_angle( &
            self) result(angle)
        class(fallible_angle_t), intent(in) :: self
        type(angle_t) :: angle

        angle = self%angle_
    end function

    impure elemental function fallible_angle_errors( &
            self) result(errors)
        class(fallible_angle_t), intent(in) :: self
        type(error_list_t) :: errors

        errors = self%errors_
    end function

    function fallible_angle_unit_from_unit( &
            unit) result(fallible_angle_unit)
        class(angle_unit_t), intent(in) :: unit
        type(fallible_angle_unit_t) :: fallible_angle_unit

        allocate(fallible_angle_unit%unit_, source = unit)
    end function

    function fallible_angle_unit_from_errors( &
            errors) result(fallible_angle_unit)
        type(error_list_t), intent(in) :: errors
        type(fallible_angle_unit_t) :: fallible_angle_unit

        fallible_angle_unit%errors_ = errors
    end function

    function fallible_angle_unit_from_fallible_angle_unit( &
            fallible_angle_unit, &
            module_, &
            procedure_) &
            result(new_fallible_angle_unit)
        type(fallible_angle_unit_t), intent(in) :: fallible_angle_unit
        type(module_t), intent(in) :: module_
        type(procedure_t), intent(in) :: procedure_
        type(fallible_angle_unit_t) :: new_fallible_angle_unit

        if (fallible_angle_unit%failed()) then
            new_fallible_angle_unit%errors_ = error_list_t( &
                    fallible_angle_unit%errors_, module_, procedure_)
        else
            allocate(new_fallible_angle_unit%unit_, source = &
                    fallible_angle_unit%unit_)
        end if
    end function

    elemental function fallible_angle_unit_failed( &
            self) result(failed)
        class(fallible_angle_unit_t), intent(in) :: self
        logical :: failed

        failed = self%errors_%has_any()
    end function

    function fallible_angle_unit_unit( &
            self) result(unit)
        class(fallible_angle_unit_t), intent(in) :: self
        class(angle_unit_t), allocatable :: unit

        allocate(unit, source = self%unit_)
    end function

    impure elemental function fallible_angle_unit_errors( &
            self) result(errors)
        class(fallible_angle_unit_t), intent(in) :: self
        type(error_list_t) :: errors

        errors = self%errors_
    end function

    elemental function simple_unit_to_string(self) result(string)
        class(angle_simple_unit_t), intent(in) :: self
        type(varying_string) :: string

        string = trim(self%symbol)
    end function

    pure function simple_value_to_string(self, value_) result(string)
        class(angle_simple_unit_t), intent(in) :: self
        type(varying_string), intent(in) :: value_
        type(varying_string) :: string

        string = value_ // " " // self%to_string()
    end function

    function simple_parse_as(self, string) result(fallible_angle)
        class(angle_simple_unit_t), intent(in) :: self
        type(varying_string), intent(in) :: string
        type(fallible_angle_t) :: fallible_angle

        type(parse_result_t) :: parse_result

        parse_result = parse_with(the_parser, string)
        if (parse_result%ok) then
            select type (the_number => parse_result%parsed)
            type is (parsed_rational_t)
                fallible_angle = fallible_angle_t(the_number%value_.unit.self)
            end select
        else
            fallible_angle = fallible_angle_t(error_list_t(fatal_t( &
                    PARSE_ERROR, &
                    module_t(MODULE_NAME), &
                    procedure_t("simple_parse_as"), &
                    parse_result%message)))
        end if
    contains
        function the_parser(state_) result(result_)
            type(state_t), intent(in) :: state_
            type(parser_output_t) :: result_

            result_ = then_drop( &
                    then_drop(parse_rational, parse_space, state_), &
                    parse_unit)
        end function

        function parse_unit(state_) result(result_)
            type(state_t), intent(in) :: state_
            type(parser_output_t) :: result_

            result_ = then_drop( &
                    parse_string(trim(self%symbol), state_), &
                    parse_end)
        end function

        function parse_end(state_) result(result_)
            type(state_t), intent(in) :: state_
            type(parser_output_t) :: result_

            result_ = either(parse_end_of_input, parse_whitespace, state_)
        end function
    end function

    function parse_angle_unit_c(string) result(fallible_angle_unit)
        character(len=*), intent(in) :: string
        type(fallible_angle_unit_t) :: fallible_angle_unit

        fallible_angle_unit = fallible_angle_unit_t( &
                parse_angle_unit(var_str(string), PROVIDED_UNITS), &
                module_t(MODULE_NAME), &
                procedure_t("parse_angle_unit_c"))
    end function

    function parse_angle_unit_s(string) result(fallible_angle_unit)
        type(varying_string), intent(in) :: string
        type(fallible_angle_unit_t) :: fallible_angle_unit

        fallible_angle_unit = fallible_angle_unit_t( &
                parse_angle_unit(string, PROVIDED_UNITS), &
                module_t(MODULE_NAME), &
                procedure_t("parse_angle_unit_s"))
    end function

    function parse_angle_unit_with_units_c( &
            string, units) result(fallible_angle_unit)
        character(len=*), intent(in) :: string
        class(angle_unit_t), intent(in) :: units(:)
        type(fallible_angle_unit_t) :: fallible_angle_unit

        fallible_angle_unit = fallible_angle_unit_t( &
                parse_angle_unit(var_str(string), units), &
                module_t(MODULE_NAME), &
                procedure_t("parse_angle_unit_with_units_c"))
    end function

    function parse_angle_unit_with_units_s( &
            string, units) result(fallible_angle_unit)
        type(varying_string), intent(in) :: string
        class(angle_unit_t), intent(in) :: units(:)
        type(fallible_angle_unit_t) :: fallible_angle_unit

        integer :: i
        type(varying_string) :: unit_strings(size(units))

        do i = 1, size(units)
            if (string == units(i)%to_string()) then
                fallible_angle_unit = fallible_angle_unit_t(units(i))
                return
            end if
        end do
        do i = 1, size(units)
            unit_strings(i) = units(i)%to_string()
        end do
        fallible_angle_unit = fallible_angle_unit_t(error_list_t(fatal_t( &
                UNKNOWN_UNIT, &
                module_t(MODULE_NAME), &
                procedure_t("parse_angle_unit_with_units_s"), &
                '"' // string // '", known units: [' // join(unit_strings, ', ') // ']')))
    end function

    elemental function sin_(angle)
        type(angle_t), intent(in) :: angle
        double precision :: sin_

        sin_ = sin(angle%radians)
    end function

    elemental function cos_(angle)
        type(angle_t), intent(in) :: angle
        double precision :: cos_

        cos_ = cos(angle%radians)
    end function

    elemental function tan_(angle)
        type(angle_t), intent(in) :: angle
        double precision :: tan_

        tan_ = tan(angle%radians)
    end function

    elemental function asin_(number) result(angle)
        double precision, intent(in) :: number
        type(angle_t) :: angle

        angle%radians = asin(number)
    end function

    elemental function acos_(number) result(angle)
        double precision, intent(in) :: number
        type(angle_t) :: angle

        angle%radians = acos(number)
    end function

    elemental function atan_(number) result(angle)
        double precision, intent(in) :: number
        type(angle_t) :: angle

        angle%radians = atan(number)
    end function

    elemental function atan2_(y, x) result(angle)
        double precision, intent(in) :: y
        double precision, intent(in) :: x
        type(angle_t) :: angle

        angle%radians = atan2(y, x)
    end function
end module

max_stars_repo_name: everythingfunctional/quaff

max_issues_repo_name: everythingfunctional/quaff

max_forks_repo_name: everythingfunctional/quaff


text:
module Svc {

  active component BufferLogger {

    # ----------------------------------------------------------------------
    # General ports
    # ----------------------------------------------------------------------

    @ Buffer input port
    async input port bufferSendIn: Fw.BufferSend

    @ Buffer output port
    output port bufferSendOut: Fw.BufferSend

    @ Packet input port
    async input port comIn: Fw.Com

    @ Ping input port
    async input port pingIn: Svc.Ping

    @ Ping output port
    output port pingOut: Svc.Ping

    async input port schedIn: Svc.Sched

    # ----------------------------------------------------------------------
    # Special ports
    # ----------------------------------------------------------------------

    @ Port for receiving commands
    command recv port cmdIn

    @ Port for sending command registration requests
    command reg port cmdRegOut

    @ Port for sending command response
    command resp port cmdResponseOut

    @ Port for emitting events
    event port eventOut

    @ Port for emitting text events
    text event port eventOutText

    @ Port for getting the time
    time get port timeCaller

    @ Port for emitting telemetry
    telemetry port tlmOut

    # ----------------------------------------------------------------------
    # Commands
    # ----------------------------------------------------------------------

    include "Commands.fppi"

    # ----------------------------------------------------------------------
    # Events
    # ----------------------------------------------------------------------

    include "Events.fppi"

    # ----------------------------------------------------------------------
    # Telemetry
    # ----------------------------------------------------------------------

    include "Telemetry.fppi"

  }

}

ext: fpp