From f0d3238f17070e1c2f425d6a6d15b9e3afeb3f27 Mon Sep 17 00:00:00 2001 From: Brad Nelson Date: Sun, 24 Apr 2022 12:03:23 -0700 Subject: [PATCH] Fixing ../ with needs. --- common/all_tests.fs | 1 + common/including.fs | 15 ++++++- common/including_tests/bar/a.fs | 2 + common/including_tests/bar/b.fs | 1 + common/including_tests/foo/a.fs | 2 + common/including_tests/foo/b.fs | 1 + common/including_tests/including_tests.fs | 55 +++++++++++++++++++++++ common/including_tests/x.fs | 5 +++ 8 files changed, 81 insertions(+), 1 deletion(-) create mode 100644 common/including_tests/bar/a.fs create mode 100644 common/including_tests/bar/b.fs create mode 100644 common/including_tests/foo/a.fs create mode 100644 common/including_tests/foo/b.fs create mode 100644 common/including_tests/including_tests.fs create mode 100644 common/including_tests/x.fs diff --git a/common/all_tests.fs b/common/all_tests.fs index b6485fc..a8c5f29 100644 --- a/common/all_tests.fs +++ b/common/all_tests.fs @@ -23,4 +23,5 @@ needs conditionals_tests.fs needs float_tests.fs needs forth_namespace_tests.fs needs structures_tests.fs +needs including_tests/including_tests.fs run-tests diff --git a/common/including.fs b/common/including.fs index fb98386..ecdd1c5 100644 --- a/common/including.fs +++ b/common/including.fs @@ -16,11 +16,19 @@ internals definitions +: ends/ ( a n -- f ) 1- + c@ [char] / = ; : dirname ( a n -- ) + dup if + 2dup ends/ if 1- then + then begin dup while - 2dup 1- + c@ [char] / = if exit then 1- + 2dup ends/ if exit then 1- repeat ; +: starts../ ( a n -- f ) + 3 < if drop 0 exit then + 3 s" ../" str= ; + 0 value sourcefilename& 0 value sourcefilename# : sourcefilename ( -- a n ) sourcefilename& sourcefilename# ; @@ -46,6 +54,11 @@ internals definitions a# b# + { r# } r# cell+ cell+ allocate throw { r } 2 cells +to r 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 r# r cell - ! r r# ; diff --git a/common/including_tests/bar/a.fs b/common/including_tests/bar/a.fs new file mode 100644 index 0000000..3cd20f3 --- /dev/null +++ b/common/including_tests/bar/a.fs @@ -0,0 +1,2 @@ +." bar/a.fs" cr +needs ../foo/b.fs diff --git a/common/including_tests/bar/b.fs b/common/including_tests/bar/b.fs new file mode 100644 index 0000000..1780515 --- /dev/null +++ b/common/including_tests/bar/b.fs @@ -0,0 +1 @@ +." bar/b.fs" cr diff --git a/common/including_tests/foo/a.fs b/common/including_tests/foo/a.fs new file mode 100644 index 0000000..79a273c --- /dev/null +++ b/common/including_tests/foo/a.fs @@ -0,0 +1,2 @@ +." foo/a.fs" cr +needs ../bar/b.fs diff --git a/common/including_tests/foo/b.fs b/common/including_tests/foo/b.fs new file mode 100644 index 0000000..ccfdf7e --- /dev/null +++ b/common/including_tests/foo/b.fs @@ -0,0 +1 @@ +." foo/b.fs" cr diff --git a/common/including_tests/including_tests.fs b/common/including_tests/including_tests.fs new file mode 100644 index 0000000..d9c74da --- /dev/null +++ b/common/including_tests/including_tests.fs @@ -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 diff --git a/common/including_tests/x.fs b/common/including_tests/x.fs new file mode 100644 index 0000000..83232ee --- /dev/null +++ b/common/including_tests/x.fs @@ -0,0 +1,5 @@ +." x.fs 1" cr +needs foo/a.fs +." x.fs 2" cr +needs bar/a.fs +." x.fs 3" cr