2009-09-09 Basile Starynkevitch <basile@starynkevitch.net>

	[still buggy; reduced tmatch-5.melt to an even simpler example]
	* gcc/melt/warmelt-first.melt: added integerbox_of cmatcher.
	* gcc/melt/warmelt-normatch.melt: added more debug ..
	* gcc/gcc/testsuite/melt/tmatch-5.melt: even simpler test.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@151572 138bc75d-0d04-0410-961f-82ee72b054a4

4 files changed, 68 insertions, 15 deletions

diff --git a/gcc/ChangeLog.MELT b/gcc/ChangeLog.MELT
index b4abbd3a4d6..423c646c8cf 100644
--- a/gcc/ChangeLog.MELT
+++ b/gcc/ChangeLog.MELT
@@ -1,5 +1,11 @@
 
-2009-09-00  Basile Starynkevitch  <basile@starynkevitch.net>
+2009-09-09  Basile Starynkevitch  <basile@starynkevitch.net>
+	[still buggy; reduced tmatch-5.melt to an even simpler example]
+	* melt/warmelt-first.melt: added integerbox_of cmatcher.
+	* melt/warmelt-normatch.melt: added more debug ..
+	* gcc/testsuite/melt/tmatch-5.melt: even simpler test.
+
+2009-09-09  Basile Starynkevitch  <basile@starynkevitch.net>
 	[while adding makedoc command, found a bug in matcher translation,
 	so added testcase tmatch-5.melt]
 	* doc/melt.texi: Improved documentation about quote, and example
diff --git a/gcc/melt/warmelt-first.melt b/gcc/melt/warmelt-first.melt
index 6da5c78a5b7..02310e3db2b 100644
--- a/gcc/melt/warmelt-first.melt
+++ b/gcc/melt/warmelt-first.melt
@@ -1253,6 +1253,17 @@ discriminant $DIS.}#
 (defprimitive make_integerbox (discr :long n) :value
   "(meltgc_new_int((meltobject_ptr_t)(" discr "), (" n ")))")
 
+;;; pattern
+(defcmatcher integerbox_of 
+  (:value bx)
+  (:long ict)
+  iboxof
+  ;; test
+  #{ /* $iboxof ?*/ $bx && melt_magic_discr($bx) == OBMAG_INT }#
+  ;; fill
+  #{ /* $iboxof !*/ $ict = ((struct meltint_st*)$bx)->val; }#
+)
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;; BOX primitives (boxed values)
 ;; test
@@ -4579,11 +4590,12 @@ discriminant $DIS.}#
  )
 
 
-;; export the citerators defined above
+;; export the citerators & cmatchers defined above
 (export_values
  foreach_in_list
  foreach_in_multiple
  foreach_long_upto
+ integerbox_of 
  )
 
 ;; eof warmelt-first.melt
\ No newline at end of file
diff --git a/gcc/melt/warmelt-normatch.melt b/gcc/melt/warmelt-normatch.melt
index 8dc8be4887e..8c3ab360cbd 100644
--- a/gcc/melt/warmelt-normatch.melt
+++ b/gcc/melt/warmelt-normatch.melt
@@ -499,6 +499,8 @@
        (if (is_a nextester class_normtester_any)
 	   (setq curtester nextester)
 	 (exit lastesterloop))))
+    (debug_msg curtester "set_newtester_lastthen curtester")
+    (assert_msg "check curtester set_newtester_lastthen" curtester)
     (put_fields testercont :container_value curtester)
     (put_tester_then curtester newtester)
     (debug_msg testercont "set_newtester_lastthen end testercont")
@@ -852,7 +854,10 @@
 	      (cursubpat (get_field :spaf_pattern curpatf))
 	      (curfldcla (get_field :fld_ownclass curfld))
 	      (testercont (instance class_container))
-	      (subhdler (lambda (newtester) (set_newtester_lastthen newtester testercont)))
+	      (subhdler (lambda (newtester)
+			  (debug_msg newtester "normpat_instancepat.subhdler newtester")
+			  (assert_msg "normpat_instancepat.subhdler check newtester" newtester)
+			  (set_newtester_lastthen newtester testercont)))
 	      )
 	 (debug_msg curfld "normpat_instancepat curfld")
 	 (cond  ( (== curfldcla patcla) ())
diff --git a/gcc/testsuite/melt/tmatch-5.melt b/gcc/testsuite/melt/tmatch-5.melt
index 4d38d435109..3401ccd3f4e 100644
--- a/gcc/testsuite/melt/tmatch-5.melt
+++ b/gcc/testsuite/melt/tmatch-5.melt
@@ -2,22 +2,52 @@
 ;; file tmatch-5.melt
 
 #| run in buildir/gcc
- ./cc1 -fmelt=translatefile  -fmelt-module-path=.    -fmelt-source-path=.:...melt-source \
+ ./cc1 -fmelt=translatefile  -fmelt-module-path=.    -fmelt-source-path=.:$GCCMELTSOURCE/gcc/melt \
     -fmelt-compile-script=./built-melt-cc-script \
     -fmelt-tempdir=/tmp -fmelt-init=@warmelt2 \
-    -fmelt-arg=.../tmatch-5.melt -fmelt-debug empty-file-for-melt.c
+    -fmelt-arg=$GCCMELTSOURCE/gcc/testsuite/melt/tmatch-5.melt -fmelt-debug empty-file-for-melt.c
 |#
 
-(defun tmatch5 (curexp)
+
+(defun tmini5 (x g)
   (match 
-   curexp 
-   (?(instance class_srcdef 
-	       :sdef_name ?dnam
-	       :sdef_doc ?(as ?doc ?(instance class_sexpr :loca_location ?loc :sexp_contents ?docl)))
-     (debug_msg dnam "makedoc_docmd dnam")
-     (debug_msg doc "makedoc_docmd doc")
-     )
-   )
-  )
+   x
+   ( ?(instance 
+       class_container 
+       :container_value 
+       ?(integerbox_of ?_))
+      (g x)
+      )
+   ))
 
+;;  (defun tmatch5 (curexp)
+;;    (match 
+;;     curexp 
+;;     (?(instance 
+;;        class_srcdef 
+;;        :sdef_name ?dnam
+;;        :sdef_doc 
+;;        ?(as ?doc 
+;;  	   ;; what crashes the test is the below pattern;
+;;  	   ;; it passes if replaced by either of
+;;  	   ;;;; a joker,  
+;;  	   ;;;; a pattern-variable.
+;;  	   ;; 
+;;  	   ;; and the original test was the crash with the below instance
+;;  	   #|
+;;  	   ?(instance class_sexpr 
+;;  		      ; :loca_location ?loc 
+;;  		      ; :sexp_contents ?docl
+;;  		      )
+;;  	   |#
+;;  	   ;; but this simple cmatcher is enough
+;;  	   ?(integerbox_of ?_)
+;;  	   )
+;;        )
+;;       (debug_msg dnam "makedoc_docmd dnam")
+;;       (debug_msg doc "makedoc_docmd doc")
+;;       )
+;;     )
+;;    )
+;;  
 ;; eof tmatch-5.melt
\ No newline at end of file