Changeset 14661 in project


Ignore:
Timestamp:
05/16/09 14:43:49 (10 years ago)
Author:
sjamaan
Message:

Add an include-relative macro to s48-modules; bump version to 0.3

Location:
release/4/s48-modules
Files:
8 added
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/s48-modules/s48-modules.scm

    r14558 r14661  
    33
    44(module s48-modules (define-structure define-interface
    5                       define-structures)
     5                      define-structures include-relative)
    66
    77  (import scheme chicken srfi-1 files)
    88
    99  (begin-for-syntax
    10    (require 'srfi-1 'files)
     10   (require 'srfi-1 'files 'posix)
    1111   (define s48-modules:*interfaces* '()) )
     12
     13  ;; Evil hackery to get around the way INCLUDE works
     14  (define-for-syntax s48-modules:*current-file* #f)
     15
     16  (define-syntax s48-modules:set-current-file!
     17    (lambda (x r c)
     18      (set! s48-modules:*current-file* (cadr x))
     19      `(,(r 'begin))) )
     20
     21  (define-for-syntax (s48-modules:get-current-file)
     22    (or s48-modules:*current-file*
     23        (and (memq #:compiling ##sys#features) ##compiler#source-filename)
     24        ##sys#current-source-filename))
     25
     26  (define-syntax include-relative
     27    (lambda (x r c)
     28      (let* ((old-file (s48-modules:get-current-file))
     29             (file (make-pathname (pathname-directory old-file) (cadr x))))
     30        `(,(r 'begin)
     31          (,(r 's48-modules:set-current-file!) ,file)
     32          (,(r 'include) ,file)
     33          (,(r 's48-modules:set-current-file!) ,old-file) ) )) )
    1234
    1335  (define-for-syntax (s48-modules:parse-interface loc iface r c)
     
    6789             (%prefix (r 'prefix))
    6890             (%module (r 'module))
    69              (%include (r 'include))
     91             (%include-relative (r 'include-relative))
    7092             (%import (r 'import))
    7193             (%import-for-syntax (r 'import-for-syntax))
     
    133155                      ((c %files (car clause))
    134156                       (set! defs
    135                          (cons `(,%include
     157                         (cons `(,%include-relative
    136158                                 ,@(map
    137159                                    (lambda (fspec)
  • release/4/s48-modules/s48-modules.setup

    r14558 r14661  
    55 's48-modules
    66 '("s48-modules.so" "s48-modules.import.so")
    7  `((version 0.2)
     7 `((version 0.3)
    88   (documentation "s48-modules.html")))
  • release/4/s48-modules/tests/run.scm

    r14660 r14661  
    1111;; We're using EVAL everywhere because we want to have the TEST form
    1212;; trap all errors, including those raised at macro expansion time.
    13 (test "import s48 module"
    14       3
    15       (eval '(begin (define-structure s48-exports
    16                       (export c1)
    17                       (open scheme)
    18                       (begin (define c1 3)
    19                              (define d1 4)))
     13
     14(test-group "basics"
     15  (test "import s48 module"
     16        3
     17        (eval '(begin (define-structure s48-exports
     18                        (export c1)
     19                        (open scheme)
     20                        (begin (define c1 3)
     21                               (define d1 4)))
    2022             
    21                     (import s48-exports)
     23                      (import s48-exports)
    2224             
    23                     c1)))
     25                      c1)))
    2426
    25 (test-error "non-exported symbols not accessible"
    26             (begin (import s48-exports) d1))
     27  (test-error "non-exported symbols not accessible"
     28              (begin
     29                (define-structure s48-exports
     30                  (export c1)
     31                  (open scheme)
     32                  (begin (define c1 3)
     33                         (define d1 4)))
     34                (import s48-exports) d1))
    2735
    28 (test "importing from chicken modules"
    29       11
    30       (eval '(begin
    31                (define-structure s48-import-from-chicken
    32                  (export e1)
    33                  (open scheme chicken-exports)
    34                  (begin (define e1 (+ a1 10))))
     36  (test "importing from chicken modules"
     37        11
     38        (eval '(begin
     39                 (define-structure s48-import-from-chicken
     40                   (export e1)
     41                   (open scheme chicken-exports)
     42                   (begin (define e1 (+ a1 10))))
    3543       
    36                (import s48-import-from-chicken)
     44                 (import s48-import-from-chicken)
    3745       
    38                e1)))
     46                 e1)))
    3947
    40 (test-error "error on undefined variable (ignore warning)"
    41             (eval '(define-structure missing-chicken-import
    42                      (export g1)
    43                      (open scheme)
    44                      (begin (define f1 a1)))))
     48  (test-error "error on undefined variable (ignore warning)"
     49              (eval '(define-structure missing-chicken-import
     50                       (export g1)
     51                       (open scheme)
     52                       (begin (define f1 a1)))))
    4553
    46 (test-error "error when not importing core scheme (ignore warning)"
    47             (eval '(define-structure missing-scheme-import
    48                      (export h1)
    49                      (begin (define h1 1)))))
     54  (test-error "error when not importing core scheme (ignore warning)"
     55              (eval '(define-structure missing-scheme-import
     56                       (export h1)
     57                       (begin (define h1 1)))))
    5058
    51 (test "prefixed import"
    52       101
    53       (eval '(begin
    54                (define-structure prefixed-import
    55                  (export i1)
    56                  (open scheme (with-prefix chicken-exports p:))
    57                  (begin (define i1 (+ p:a1 100))))
    58                (import prefixed-import)
    59                i1)))
     59  (test "prefixed import"
     60        101
     61        (eval '(begin
     62                 (define-structure prefixed-import
     63                   (export i1)
     64                   (open scheme (with-prefix chicken-exports p:))
     65                   (begin (define i1 (+ p:a1 100))))
     66                 (import prefixed-import)
     67                 i1))))
    6068
    61 (test "include file in current dir"
    62       102
    63       (eval '(begin
    64                (define-structure simple-file-import
    65                  (export j1)
    66                  (open scheme)
    67                  (files simple-file-import))
    68                (import simple-file-import)
    69                j1)))
     69(test-group "include-relative"
     70  (test "include file in current dir"
     71        102
     72        (eval '(begin
     73                 (define-structure simple-file-import
     74                   (export j1)
     75                   (open scheme)
     76                   (files simple-file-import))
     77                 (import simple-file-import)
     78                 j1)))
    7079
    71 (test "include file in subdir"
    72       103
    73       (eval '(begin
    74                (define-structure subdir-file-import
    75                  (export k1)
    76                  (open scheme)
    77                  (files subdir/subdir-file-import))
    78                (import subdir-file-import)
    79                k1)))
     80  (test "include file in subdir"
     81        103
     82        (eval '(begin
     83                 (define-structure subdir-file-import
     84                   (export k1)
     85                   (open scheme)
     86                   (files subdir/subdir-file-import))
     87                 (import subdir-file-import)
     88                 k1)))
    8089
    81 ;; This will not work because of how INCLUDE works; it's always expanded
    82 ;; before any macros are
    83 #;(test "include file in subsubdir"
    84       104
    85       (eval '(begin
    86                (include-structure-definition "subdir/subdir-inclusion.scm")
    87                (import subsubdir-file-import)
    88                l1)))
     90  (test "include file in subsubdir"
     91        104
     92        (eval '(begin
     93                 (include-relative "subdir/direct-inclusion.scm")
     94                 (import subsubdir-file-import)
     95                 l1)))
     96
     97  (test "indirectly include file in subsubdir"
     98        105
     99        (eval '(begin
     100                 (include-relative "subdir/indirect-inclusion.scm")
     101                 (import subsubdir-indirect-file-import)
     102                 m1)))
     103
     104  (test "include file in two different subdirs"
     105        106
     106        (eval '(begin
     107                 (define-structure subdir-file-import
     108                   (export k1)
     109                   (open scheme)
     110                   (files subdir/subdir-file-import))
     111                 (define-structure subdir2-file-import
     112                   (export n1)
     113                   (open scheme)
     114                   (files subdir2/subdir2-file-import))
     115                 (import subdir2-file-import)
     116                 n1))))
Note: See TracChangeset for help on using the changeset viewer.