Forth и другие саморасширяющиеся системы программирования Locations of visitors to this page
Текущее время: Пт мар 29, 2024 02:49

...
Google Search
Forth-FAQ Spy Grafic

Часовой пояс: UTC + 3 часа [ Летнее время ]




Начать новую тему Ответить на тему  [ Сообщений: 19 ]  На страницу Пред.  1, 2
Автор Сообщение
 Заголовок сообщения:
СообщениеДобавлено: Ср май 30, 2007 14:15 
Собственно, начиная с сегодня для меня вопрос закрыт. Сегодня я написал слегка написал немного слишком показательный, но и рабочий (в смысле -- он идёт в работу) код для ~profit/lib/logic.f:

Код:
\ Дополнительные слова для логических выражений
\ которых нет в коробке SPF.
\ Чисто красоты для.

REQUIRE /TEST ~profit/lib/testing.f

\ : NOT IF FALSE ELSE TRUE THEN ; ( \ вариант для пуристов
: NOT  0= ;                         \ вариант для нормальных пацанов )
: <=   > NOT ;
: >=   < NOT ;

/TEST

REQUIRE TESTCASES ~ygrek/lib/testcase.f
TESTCASES logic

(( TRUE  NOT -> FALSE ))
(( FALSE NOT -> TRUE  ))
(( 3 3 >=    -> TRUE  ))
(( 3 4 >=    -> FALSE ))
(( 4 3 >=    -> TRUE  ))
(( 3 3 <=    -> TRUE  ))
(( 3 4 <=    -> TRUE  ))
(( 4 3 <=    -> FALSE ))
(( TRUE NOT NOT -> TRUE ))
(( FALSE NOT NOT -> FALSE ))

END-TESTCASES


Весьма-с, весьма-с приятственно, и крайне недурственно.

Кроме обычной проверки вывода слова через стек, есть и проверка состояний областей памяти (и строк заодно) там есть, через слово TEST-ARRAY. Если нужно будет проверять вывод можно использовать ~ygrek/lib/typestr.f и перенаправлять текстовый вывод в строку которую и проверять потом.

Вот они, эффекты SPF_DEVEL. TESTCASES написал ~day, /TEST -- ~profit, TYPE>STR -- ~yrgek. Синергия, понимаешь.


Вернуться к началу
  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Ср июн 13, 2007 19:54 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 5062
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 23 раз.
Поблагодарили: 63 раз.
Просьба к модератору перекинуть данную тему в подфорум SPF4

Тут дальнейшее развитие идеи автоматического тестирования библиотек.
Речь идет о времени компиляции, то есть библиотека просто подключается, но при этом производится анализ состояния стека,
контекста, переменных BASE CURRENT STATE

<pre>
\ 06-06-2007 ~mOleg
\ Copyright [C] 2007 mOleg mininoleg@yahoo.com
\ подключение библиотеки в режиме тестирования
\ с автоматической проверкой изменений произошедших в системе
\ после подключения указанной библиотеки.

REQUIRE ?DEFINED devel\~moleg\lib\util\ifdef.f
REQUIRE MARKERS devel\~mOleg\lib\util\marks.f
REQUIRE TILL devel\~mOleg\lib\util\for-next.f

\ укоротить строку asc # на u символов от начала
: SKIPn ( asc # u --> asc+u #-u ) OVER MIN TUCK - >R + R> ;

\ распечатать строку в поле шириной l символов,
\ если строка длиннее l, печатать хвост строки длиной в l символов
: TYPE] ( asc # l --> )
2DUP >
IF OVER SWAP - SKIPn TYPE
ELSE OVER - 0 MAX >R TYPE R> SPACES
THEN ;

\ вернуть FALSE если содержимое массивов или длина не равны
: cmparr ( [a1] # [a2] # --> flag )
SP@ OVER 1 + CELLS 2DUP 2>R +
2R> TUCK COMPARE 0= ;

FALSE WARNING ! \ -----------------------------------------------------------

USER TESTING \ включение режима тестирования

\ интерпретировать указанный файл, если в контексте не найдено слово key
\ режим тестирования сбрасывается для всех вложенных файлов.
: REQUIRE ( / key file --> )
FALSE TESTING change >R
REQUIRE
R> TESTING ! ;

\ интерпретировать файл, имя которого идентифицируется строкой ascZ #
\ режим тестирования сбрасывается для всех вложенных файлов
: INCLUDED ( ascZ # --> )
FALSE TESTING change >R
INCLUDED
R> TESTING ! ;

\ попытаться подключить файл в режиме тестирования
: (TESTED) ( asc # --> flag )
TRUE TESTING !
CR ." Testing: " 2DUP 0x46 OVER - 0 MAX TYPE]
['] (INCLUDED) CATCH
DUP IF CR ." can't compile library"
CR ERR-STRING TYPE CR
THEN ;

USER last-base \ переменная для контроля изменений состояния BASE
USER last-current \ переменная для контроля изменений CURRENT
USER last-context \ указатель на копию контекста

\ проверить, были ли изменения на вершине стека данных
: ?DepthChanges ( ?? )
TestMoment
IFNOT CR ." stack leaking"
ValidMark
IF CR ." superfluous values: "
CountToMark .SN ClearToMark
ELSE
CR ." stack underflow for "
ForgetMark CountToMark 10 SWAP - . ." cells"
THEN ClearToMark
RDROP EXIT
THEN ForgetMark ;

\ проверить изменения текущей системы исчисления
: ?base ( --> )
BASE @ last-base @ <>
IF 0 last-base change BASE !
CR S" BASE changed" TYPE
THEN ;

\ изменен ли текущий словарь?
: ?current ( --> )
GET-CURRENT last-current @ <>
IF last-current @ SET-CURRENT
CR S" CURRENT changed" TYPE
THEN ;

\ все ли слова в подключаемом файле завершены
: ?state ( --> )
STATE @
IF FALSE STATE !
CR S" STATE was ON" TYPE
THEN ;

\ есть ли изменения в контексте
: ?context ( --> )
GET-ORDER last-context @ GetFrom cmparr
IFNOT CR S" CONTEXT was changed" TYPE
SET-ORDER
ELSE nDROP
THEN nDROP
last-context @ KillStack ;

\ массив для тестирования
: TestArray ( --> [arr] # ) 10 FOR R@ TILL ;

\ проверить, есть ли изменения под вершиной стека данных
: ?InternalCanges ( ?? )
CountToMark MarkMoment TestArray CountToMark cmparr
IFNOT ClearToMark CR S" " TYPE .SN ." <--"
ELSE ClearToMark
THEN ;

\ подключить указанный файл в режиме тестирования
: TESTED ( ascZ # --> )
last-base @ IF CR ." nested testing unsupported" -1 THROW THEN

BASE @ last-base ! \ сохранили текущую систему исчисления
GET-CURRENT last-current ! \ запомнили текущий словарь

\ запомнили текущий контекст
GET-ORDER 0x10 NewStack DUP last-context ! MoveTo

\ запомнили текущий указатель вершины стека данных
2>R init-markers MarkMoment

\ добавили 10 чисел от 1 до 10 на вершину стека данных,
\ запомнили текущую позицию
TestArray MarkMoment

\ подключаем тестируемый файл
2R> (TESTED)
IF \ если ошибка, восстанавливаем все:
0 last-base change BASE ! \ систему исчисления
last-current @ SET-CURRENT \ текущий словарь
FALSE STATE ! \ режим интерпретации
ForgetMark ClearToMark \ чистим стек данных
\ восстанавливаем контекст
last-context @ DUP GetFrom SET-ORDER
KillStack \ удаляем временный стек
EXIT \ и выходим. Восстанавливать HERE не имеет смысла
THEN

?base
?current
?context
?state
?DepthChanges
?InternalCanges ClearToMark

." passed" ;

TRUE WARNING ! \ ------------------------------------------------------------

?DEFINED test{ \EOF

test{ \ просто тест на подключаемость.
S" passed" TYPE
}test \EOF

</pre>


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Ср июн 13, 2007 21:04 
Не в сети

Зарегистрирован: Чт май 04, 2006 18:18
Сообщения: 456
Благодарил (а): 0 раз.
Поблагодарили: 1 раз.
mOleg писал(а):
\ укоротить строку asc # на u символов от начала
: SKIPn ( asc # u --> asc+u #-u ) OVER MIN TUCK - >R + R> ;

Код:
REQUIRE /STRING lib/include/string.f

_________________
http://forth.org.ru/~ygrek


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Ср июн 13, 2007 21:21 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 5062
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 23 раз.
Поблагодарили: 63 раз.
ygrek писал(а):
\ укоротить строку asc # на u символов от начала

: SKIPn ( asc # u --> asc+u #-u ) OVER MIN TUCK - >R + R> ;



Код:

REQUIRE /STRING lib/include/string.f


1) не принципиально
2) в string.f другое поведение, если n больше длины строки.


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 19 ]  На страницу Пред.  1, 2

Часовой пояс: UTC + 3 часа [ Летнее время ]


Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 12


Вы не можете начинать темы
Вы можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

cron
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
phpBB сборка от FladeX // Русская поддержка phpBB