Re: [RFC] using autogen to audit fortran intrinsics?!

[Bruce Korb <bkorb at gnu dot org>]

Hi Daniel,

Attached is my best guess at what you are after.
I didn't do the "run" part, but the "compile" part
should give you an idea about how to approach this.
Attached are:

ftn.def - defines the one intrinsic we are playing with

ftn-test.tpl - produces a long program for testing all
argument variations for each intrinsic.  You might actually
find it easier to manage by producing a separate program
for every invocation of the intrinsic.  Define a "valid
combo" list for the intrinsic and expect a successful
compilation only when the current combination matches
an entry from the "valid combo" list.  This, however, was
what I think you described as what you wanted.

ftn-besj0-comp.ftn - the compile test file for "besj0".

ftn-besj0-run.ftn - the program that should eventually compile & run

ftn-test.sh - a script to compile each of the *.ftn files
and run the ftn-*-run programs

Good luck!

Regards, Bruce

AutoGen Definitions ftn-test;

t-list =
    { typ = 'INTEGER(kind=1)'; var = i1; },
    { typ = 'INTEGER(kind=2)'; var = i2; },
    { typ = 'INTEGER(kind=4)'; var = i4; },
    { typ = 'INTEGER(kind=8)'; var = i8; },
    { typ = 'REAL(kind=4)';    var = r4; },
    { typ = 'REAL(kind=8)';    var = r8; };

intrinsic = {
  name = 'besj0';
  function_test = { argument_type  = 'real_4' ;
                    argument_value =  '0.0' ;
                    result_type    = 'real_4' ;
                    result_value   =  '0.0' ;
                    tolerance      = 'epsilon(real_4)';
                  };
};

[=

AutoGen5 Template

-test.sh

(define f-name "")

=]
[= # iterate over every value for "intrinsic": =][=

FOR intrinsic =][=

(set! f-name (string-append (base-name) "-" (get "name") "-comp.ftn"))
(ag-fprintf 0 "fort77 %s\n" f-name)
(out-push-new f-name)

\=]
! { dg-do compile }
program test_intrinsic_[= name =]_compile_time[=

  # declare the types in our type list ("t-list"):  =][=

  FOR t-list =]
  [= typ =] :: [= var =][=
  ENDFOR =]
[=

  # We actually know the names of the 5 variable types:
  =][=
  FOR result IN i1 i2 i4 r4 r8 =]

  [= result =] = [= name =]() ! no argument[=

    # and we need to iterate over them in three levels of nesting:
    =][=
    FOR first_arg IN i1 i2 i4 r4 r8 =]
  [= result =] = [= name =]([= first_arg =])[=

      # For the last level, we can use "t-list":
      =][=
      FOR t-list=]
  [= result =] = [= name =]([= first_arg =], [=var=])[=
      ENDFOR =][=

    ENDFOR first-arg

=][=

  ENDFOR result

=]
end program
[=

(out-pop)
(set! f-name (string-append (base-name) "-" (get "name") "-run"))
(ag-fprintf 0 "fort77 %1$s.ftn || exit 1\n./%1$s || exit 1\n" f-name)
(out-push-new (string-append f-name ".ftn")

=]
! { dg-do run }
! { dg-require-effective-target fortran_large_real }
program test_intrinsic_[= name =]_run_time
  integer, parameter :: k = selected_real_kind (precision (0.0_8) + 1)
  real(kind=k) :: arg
  real(kind=k) :: res
 
  arg = $argument_value
  res = besj0(arg)
  if (ABS($result_value - res) > $tolerance) call ABORT()
end program
[=

ENDFOR intrinsic

\=]

! { dg-do compile }
program test_intrinsic_besj0_compile_time
  INTEGER(kind=1) :: i1
  INTEGER(kind=2) :: i2
  INTEGER(kind=4) :: i4
  INTEGER(kind=8) :: i8
  REAL(kind=4) :: r4
  REAL(kind=8) :: r8


  i1 = besj0() ! no argument
  i1 = besj0(i1)
  i1 = besj0(i1, i1)
  i1 = besj0(i1, i2)
  i1 = besj0(i1, i4)
  i1 = besj0(i1, i8)
  i1 = besj0(i1, r4)
  i1 = besj0(i1, r8)
  i1 = besj0(i2)
  i1 = besj0(i2, i1)
  i1 = besj0(i2, i2)
  i1 = besj0(i2, i4)
  i1 = besj0(i2, i8)
  i1 = besj0(i2, r4)
  i1 = besj0(i2, r8)
  i1 = besj0(i4)
  i1 = besj0(i4, i1)
  i1 = besj0(i4, i2)
  i1 = besj0(i4, i4)
  i1 = besj0(i4, i8)
  i1 = besj0(i4, r4)
  i1 = besj0(i4, r8)
  i1 = besj0(r4)
  i1 = besj0(r4, i1)
  i1 = besj0(r4, i2)
  i1 = besj0(r4, i4)
  i1 = besj0(r4, i8)
  i1 = besj0(r4, r4)
  i1 = besj0(r4, r8)
  i1 = besj0(r8)
  i1 = besj0(r8, i1)
  i1 = besj0(r8, i2)
  i1 = besj0(r8, i4)
  i1 = besj0(r8, i8)
  i1 = besj0(r8, r4)
  i1 = besj0(r8, r8)

  i2 = besj0() ! no argument
  i2 = besj0(i1)
  i2 = besj0(i1, i1)
  i2 = besj0(i1, i2)
  i2 = besj0(i1, i4)
  i2 = besj0(i1, i8)
  i2 = besj0(i1, r4)
  i2 = besj0(i1, r8)
  i2 = besj0(i2)
  i2 = besj0(i2, i1)
  i2 = besj0(i2, i2)
  i2 = besj0(i2, i4)
  i2 = besj0(i2, i8)
  i2 = besj0(i2, r4)
  i2 = besj0(i2, r8)
  i2 = besj0(i4)
  i2 = besj0(i4, i1)
  i2 = besj0(i4, i2)
  i2 = besj0(i4, i4)
  i2 = besj0(i4, i8)
  i2 = besj0(i4, r4)
  i2 = besj0(i4, r8)
  i2 = besj0(r4)
  i2 = besj0(r4, i1)
  i2 = besj0(r4, i2)
  i2 = besj0(r4, i4)
  i2 = besj0(r4, i8)
  i2 = besj0(r4, r4)
  i2 = besj0(r4, r8)
  i2 = besj0(r8)
  i2 = besj0(r8, i1)
  i2 = besj0(r8, i2)
  i2 = besj0(r8, i4)
  i2 = besj0(r8, i8)
  i2 = besj0(r8, r4)
  i2 = besj0(r8, r8)

  i4 = besj0() ! no argument
  i4 = besj0(i1)
  i4 = besj0(i1, i1)
  i4 = besj0(i1, i2)
  i4 = besj0(i1, i4)
  i4 = besj0(i1, i8)
  i4 = besj0(i1, r4)
  i4 = besj0(i1, r8)
  i4 = besj0(i2)
  i4 = besj0(i2, i1)
  i4 = besj0(i2, i2)
  i4 = besj0(i2, i4)
  i4 = besj0(i2, i8)
  i4 = besj0(i2, r4)
  i4 = besj0(i2, r8)
  i4 = besj0(i4)
  i4 = besj0(i4, i1)
  i4 = besj0(i4, i2)
  i4 = besj0(i4, i4)
  i4 = besj0(i4, i8)
  i4 = besj0(i4, r4)
  i4 = besj0(i4, r8)
  i4 = besj0(r4)
  i4 = besj0(r4, i1)
  i4 = besj0(r4, i2)
  i4 = besj0(r4, i4)
  i4 = besj0(r4, i8)
  i4 = besj0(r4, r4)
  i4 = besj0(r4, r8)
  i4 = besj0(r8)
  i4 = besj0(r8, i1)
  i4 = besj0(r8, i2)
  i4 = besj0(r8, i4)
  i4 = besj0(r8, i8)
  i4 = besj0(r8, r4)
  i4 = besj0(r8, r8)

  r4 = besj0() ! no argument
  r4 = besj0(i1)
  r4 = besj0(i1, i1)
  r4 = besj0(i1, i2)
  r4 = besj0(i1, i4)
  r4 = besj0(i1, i8)
  r4 = besj0(i1, r4)
  r4 = besj0(i1, r8)
  r4 = besj0(i2)
  r4 = besj0(i2, i1)
  r4 = besj0(i2, i2)
  r4 = besj0(i2, i4)
  r4 = besj0(i2, i8)
  r4 = besj0(i2, r4)
  r4 = besj0(i2, r8)
  r4 = besj0(i4)
  r4 = besj0(i4, i1)
  r4 = besj0(i4, i2)
  r4 = besj0(i4, i4)
  r4 = besj0(i4, i8)
  r4 = besj0(i4, r4)
  r4 = besj0(i4, r8)
  r4 = besj0(r4)
  r4 = besj0(r4, i1)
  r4 = besj0(r4, i2)
  r4 = besj0(r4, i4)
  r4 = besj0(r4, i8)
  r4 = besj0(r4, r4)
  r4 = besj0(r4, r8)
  r4 = besj0(r8)
  r4 = besj0(r8, i1)
  r4 = besj0(r8, i2)
  r4 = besj0(r8, i4)
  r4 = besj0(r8, i8)
  r4 = besj0(r8, r4)
  r4 = besj0(r8, r8)

  r8 = besj0() ! no argument
  r8 = besj0(i1)
  r8 = besj0(i1, i1)
  r8 = besj0(i1, i2)
  r8 = besj0(i1, i4)
  r8 = besj0(i1, i8)
  r8 = besj0(i1, r4)
  r8 = besj0(i1, r8)
  r8 = besj0(i2)
  r8 = besj0(i2, i1)
  r8 = besj0(i2, i2)
  r8 = besj0(i2, i4)
  r8 = besj0(i2, i8)
  r8 = besj0(i2, r4)
  r8 = besj0(i2, r8)
  r8 = besj0(i4)
  r8 = besj0(i4, i1)
  r8 = besj0(i4, i2)
  r8 = besj0(i4, i4)
  r8 = besj0(i4, i8)
  r8 = besj0(i4, r4)
  r8 = besj0(i4, r8)
  r8 = besj0(r4)
  r8 = besj0(r4, i1)
  r8 = besj0(r4, i2)
  r8 = besj0(r4, i4)
  r8 = besj0(r4, i8)
  r8 = besj0(r4, r4)
  r8 = besj0(r4, r8)
  r8 = besj0(r8)
  r8 = besj0(r8, i1)
  r8 = besj0(r8, i2)
  r8 = besj0(r8, i4)
  r8 = besj0(r8, i8)
  r8 = besj0(r8, r4)
  r8 = besj0(r8, r8)
end program

! { dg-do run }
! { dg-require-effective-target fortran_large_real }
program test_intrinsic_besj0_run_time
  integer, parameter :: k = selected_real_kind (precision (0.0_8) + 1)
  real(kind=k) :: arg
  real(kind=k) :: res
 
  arg = $argument_value
  res = besj0(arg)
  if (ABS($result_value - res) > $tolerance) call ABORT()
end program

Attachment: ftn-test.sh
Description: application/shellscript