Fixing ../ with needs.

This commit is contained in:
Brad Nelson
2022-04-24 12:03:23 -07:00
parent 35a02bc61c
commit f0d3238f17
8 changed files with 81 additions and 1 deletions

View File

@ -23,4 +23,5 @@ needs conditionals_tests.fs
needs float_tests.fs needs float_tests.fs
needs forth_namespace_tests.fs needs forth_namespace_tests.fs
needs structures_tests.fs needs structures_tests.fs
needs including_tests/including_tests.fs
run-tests run-tests

View File

@ -16,11 +16,19 @@
internals definitions internals definitions
: ends/ ( a n -- f ) 1- + c@ [char] / = ;
: dirname ( a n -- ) : dirname ( a n -- )
dup if
2dup ends/ if 1- then
then
begin dup while begin dup while
2dup 1- + c@ [char] / = if exit then 1- 2dup ends/ if exit then 1-
repeat ; repeat ;
: starts../ ( a n -- f )
3 < if drop 0 exit then
3 s" ../" str= ;
0 value sourcefilename& 0 value sourcefilename&
0 value sourcefilename# 0 value sourcefilename#
: sourcefilename ( -- a n ) sourcefilename& sourcefilename# ; : sourcefilename ( -- a n ) sourcefilename& sourcefilename# ;
@ -46,6 +54,11 @@ internals definitions
a# b# + { r# } r# cell+ cell+ allocate throw { r } a# b# + { r# } r# cell+ cell+ allocate throw { r }
2 cells +to r 2 cells +to r
b c@ [char] / = if 0 to a# then b c@ [char] / = if 0 to a# then
begin b b# starts../ while
3 +to b -3 +to b#
a a# dirname to a# to a
a# b# + to r#
repeat
a r a# cmove b r a# + b# cmove a r a# cmove b r a# + b# cmove
r# r cell - ! r# r cell - !
r r# ; r r# ;

View File

@ -0,0 +1,2 @@
." bar/a.fs" cr
needs ../foo/b.fs

View File

@ -0,0 +1 @@
." bar/b.fs" cr

View File

@ -0,0 +1,2 @@
." foo/a.fs" cr
needs ../bar/b.fs

View File

@ -0,0 +1 @@
." foo/b.fs" cr

View File

@ -0,0 +1,55 @@
\ Copyright 2022 Bradley D. Nelson
\
\ Licensed under the Apache License, Version 2.0 (the "License");
\ you may not use this file except in compliance with the License.
\ You may obtain a copy of the License at
\
\ http://www.apache.org/licenses/LICENSE-2.0
\
\ Unless required by applicable law or agreed to in writing, software
\ distributed under the License is distributed on an "AS IS" BASIS,
\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
\ See the License for the specific language governing permissions and
\ limitations under the License.
( Runs in the parent source dir context )
e: test-included?
also internals included-files
s" including_tests/x.fs" included? 0= assert
s" including_tests/foo/a.fs" included? 0= assert
s" including_tests/foo/b.fs" included? 0= assert
s" including_tests/bar/a.fs" included? 0= assert
s" including_tests/bar/b.fs" included? 0= assert
include including_tests/x.fs
s" including_tests/x.fs" included? assert
s" including_tests/foo/a.fs" included? assert
s" including_tests/foo/b.fs" included? assert
s" including_tests/bar/a.fs" included? assert
s" including_tests/bar/b.fs" included? assert
to included-files
out: x.fs 1
out: foo/a.fs
out: bar/b.fs
out: x.fs 2
out: bar/a.fs
out: foo/b.fs
out: x.fs 3
;e
( Runs in the parent source dir context )
e: test-needs
also internals included-files
include including_tests/x.fs
include including_tests/x.fs
to included-files
out: x.fs 1
out: foo/a.fs
out: bar/b.fs
out: x.fs 2
out: bar/a.fs
out: foo/b.fs
out: x.fs 3
out: x.fs 1
out: x.fs 2
out: x.fs 3
;e

View File

@ -0,0 +1,5 @@
." x.fs 1" cr
needs foo/a.fs
." x.fs 2" cr
needs bar/a.fs
." x.fs 3" cr