Verified Commit 8383a462 authored by Camil Staps's avatar Camil Staps 🚀

Add test program for #68 (Clean.Parse.Comments issues with singleline...

Add test program for #68 (Clean.Parse.Comments issues with singleline documentation on the next line)
parent b3c4de5a
......@@ -3,10 +3,17 @@ test-nightly:
- install_clean.sh bundle-complete
- apt-get update -qq
- apt-get install -y -qq build-essential git coreutils libsnappy-dev
- make -C src/cdeps install
- git clone https://gitlab.science.ru.nl/clean-compiler-and-rts/compiler tests/linux64/compiler
- make -j -C tests/linux64/compiler/main/Unix
- make -j -C tests/linux64/compiler/backendC/CleanCompilerSources -f Makefile.linux64
- mkdir -p tests/linux64/compiler/backend/Clean\ System\ Files
- ln -fs ../../backendC/CleanCompilerSources/backend.a tests/linux64/compiler/backend/Clean\ System\ Files/backend_library
image: "camilstaps/clean:nightly"
script:
- make -C tests/linux64 run
- COCLPATH=./compiler make -C tests/linux64 run
- stdbuf -o0 -e0 testproperties -IL Dynamics -d src/libraries/OS-Independent -P Quiet -r -T 'Tests 100000' -C -h -C 100m
test-stable:
......
commentstest
gentest
snappytest
tartest
......
......@@ -15,12 +15,19 @@ CLMLIBS:=\
-IL GraphCopy\
-IL TCPIP
BINARIES:=checktest test gentest snappytest tartest
COCLPATH?=../../../compiler
COCLLIBS:=\
-IL ArgEnv\
-I $(COCLPATH)/frontend\
-I $(COCLPATH)/main\
-I $(COCLPATH)/main/Unix
BINARIES:=checktest test commentstest gentest snappytest tartest
RUN_BINARIES:=$(addprefix run_,$(BINARIES))
all: $(RUN_BINARIES)
$(filter-out checktest tartest snappytest,$(BINARIES)): .FORCE
$(filter-out checktest commentstest tartest snappytest,$(BINARIES)): .FORCE
$(CLM) $(CLMLIBS) -PABC StdEnv
$(CLM) $(CLMLIBS) -PABC StdMaybe
$(CLM) $(CLMLIBS) -PABC -dynamics _SystemDynamic
......@@ -50,6 +57,9 @@ run_tartest: tartest
diff -r _tartest-old _tartest
$(RM) -r _tartest-old _tartest _tartest.tar
commentstest: .FORCE
$(CLM) $(CLMLIBS) $(COCLLIBS) -nr -nt $@ -o $@
clean:
$(RM) -r $(filter-out checktest,$(BINARIES)) _tartest* Clean\ System\ Files
......
definition module commentstest
/**
* This module is used to test the Clean documentation parser in Clean.Parse.Comments.
* The documentation here is written obscurely on purpose!
*/
import syntax
import Clean.Parse.Comments
//* A documentation entry
:: Entry =
{ kind :: !String //* the kind of thing that is documented
, name :: !String
//* the name of the documented thing
, value :: !Maybe String
}
//* This type is just here to test; it isn't used
:: TrickyADT
= TrickyADT_A
//* Documentation on new line
list_comments :: !ParsedModule !CollectedComments -> [Entry]
// Don't add a comment for this function: we want to check that the last comment
// of TrickyADT is not added to list_comments_of_definitions.
implementation module commentstest
import StdEnv
import StdMaybe
import Clean.Parse
import Clean.Parse.Comments
import Data.Error
import Data.Func
import Data.GenDiff
import System.CommandLine
from Text import class Text(replaceSubString,trim), instance Text String
import syntax
dcl = "commentstest.dcl"
Start w
# (Ok (mod,_), w) = readModule dcl w
# (Ok comments, w) = scanComments dcl w
# comments = collectComments comments mod
# comments = list_comments mod comments
# diff = gDiff{|*|} expected comments
# (io,w) = stdio w
# io = io <<< diffToConsole diff <<< "\n"
# (_,w) = fclose io w
# w = let [d:_] = diff in case d.status of
Common -> w
_ -> setReturnCode -1 w
= w
expected :: [Entry]
expected =
[ {kind="module", name="commentstest", value=Just "*\n * This module is used to test the Clean documentation parser in Clean.Parse.Comments.\n * The documentation here is written obscurely on purpose!\n "}
, {kind="type", name="Entry", value=Just "* A documentation entry\n"}
, {kind="selector", name="kind", value=Just "* the kind of thing that is documented\n"}
, {kind="selector", name="name", value=Just "* the name of the documented thing\n"}
, {kind="selector", name="value", value=Nothing}
, {kind="type", name="TrickyADT", value=Just "* This type is just here to test; it isn't used\n"}
, {kind="constructor", name="TrickyADT_A", value=Just "* Documentation on new line\n"}
, {kind="typespec", name="list_comments", value=Nothing}
]
derive gDiff Entry, Maybe
list_comments :: !ParsedModule !CollectedComments -> [Entry]
list_comments mod comments
# entry =
{ kind = "module"
, name = mod.mod_ident.id_name
, value = getComment mod comments
}
= [entry:list_comments_of_definitions mod.mod_defs comments]
list_comments_of_definitions :: ![ParsedDefinition] !CollectedComments -> [Entry]
list_comments_of_definitions [] _ = []
list_comments_of_definitions [pd:pds] comments = case pd of
PD_Type {td_ident,td_rhs}
# entry =
{ kind = "type", name = td_ident.id_name
, value = getComment pd comments
}
-> [entry:list_comments_of_type_rhs td_rhs comments ++
list_comments_of_definitions pds comments]
PD_TypeSpec _ id _ _ _
# entry =
{ kind = "typespec", name = id.id_name
, value = getComment pd comments
}
-> [entry:list_comments_of_definitions pds comments]
PD_Class cd _
# entry =
{ kind = "class", name = cd.class_ident.id_name
, value = getComment pd comments
}
-> [entry:list_comments_of_definitions pds comments]
PD_Generic gd
# entry =
{ kind = "generic", name = gd.gen_ident.id_name
, value = getComment pd comments
}
-> [entry:list_comments_of_definitions pds comments]
_
-> list_comments_of_definitions pds comments
list_comments_of_type_rhs :: !RhsDefsOfType !CollectedComments -> [Entry]
list_comments_of_type_rhs rhs comments = case rhs of
ConsList pcs -> map (flip comment_of_constructor comments) pcs
ExtensibleConses pcs -> map (flip comment_of_constructor comments) pcs
MoreConses _ pcs -> map (flip comment_of_constructor comments) pcs
SelectorList _ _ _ pss -> map (flip comment_of_selector comments) pss
TypeSpec _ -> []
NewTypeCons _ -> []
EmptyRhs _ -> []
AbstractTypeSpec _ _ -> []
where
comment_of_selector :: !ParsedSelector !CollectedComments -> Entry
comment_of_selector ps comments =
{ kind = "selector", name = ps.ps_field_ident.id_name
, value = getComment ps comments
}
comment_of_constructor :: !ParsedConstructor !CollectedComments -> Entry
comment_of_constructor pc comments =
{ kind = "constructor", name = pc.pc_cons_ident.id_name
, value = getComment pc comments
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment