Correctly remove the last component of a path before concatenation.

parser/cduce_url.ml

@@ -83,16 +83,24 @@ let remove_last_char s c =
 let remove_first_char s c =
   let len = String.length s in
   if len > 0 && s.[0] == c then String.sub s 1 (len - 1) else s
-							      
+
+let remove_last_component s c =
+  try
+    let i = String.rindex s c in
+    String.sub s 0 i
+  with _ -> s
+
 let local base rel =
   match kind base, kind rel with
   | File _, File _ ->
      let base = remove_last_char base Filename.dir_sep.[0] in
+     let base = remove_last_component base Filename.dir_sep.[0] in
      let rel = remove_first_char rel Filename.dir_sep.[0] in
      Filename.concat base rel
   | _, (String _ | Uri _) | (String _, File _) -> rel
   | Uri _, File _ ->
      let base = remove_last_char base '/' in
+     let base = remove_last_component base '/' in
      let rel = remove_first_char rel '/' in
      base ^ "/" ^ rel 
 

runtime/cduce_expat.ml

@@ -2,34 +2,37 @@ let buflen = 1024
 let buf = String.create buflen
 
 let load_from_file p s =
-  let ic = 
+  let ic =
     try open_in s
     with exn ->
-      let msg = 
+      let msg =
 	Printf.sprintf "load_xml, file \"%s\": %s" s (Printexc.to_string exn)
       in
       Value.failwith' msg
   in
   let rec loop () =
     let n = input ic buf 0 buflen in
-    if (n > 0) then (Expat.parse_sub p buf 0 n; loop ()) 
+    if (n > 0) then (Expat.parse_sub p buf 0 n; loop ())
   in
   try
-    loop(); 
+    loop();
     Expat.final p;
     close_in ic
   with exn -> close_in ic; raise exn
 
 let rec push p s =
-  Expat.set_external_entity_ref_handler p 
-    (fun ctx base sys pub -> 
-       let s = Cduce_url.local s sys in
+  Expat.set_external_entity_ref_handler p
+    (fun ctx base sys pub ->
+     let old_s = s in
+     let s = Cduce_url.local s sys in
+     Format.eprintf "Url.local '%s' '%s' = '%s' @\n%!" old_s sys s;
+
        let p = Expat.external_entity_parser_create p ctx None in
        push p s);
   try
     if Cduce_url.is_url s then Expat.parse p (Cduce_url.load_url s)
     else load_from_file p s
-  with Expat.Expat_error e -> 
+  with Expat.Expat_error e ->
     let msg =
       Printf.sprintf
 	"load_xml,%s at line %i, column %i: %s"
@@ -48,16 +51,16 @@ let rec load_expat se ee txt s =
   ignore (Expat.set_param_entity_parsing p Expat.ALWAYS);
   push p s
 
-let use () = Load_xml.xml_parser := 
+let use () = Load_xml.xml_parser :=
   load_expat Load_xml.start_element_handler Load_xml.end_element_handler
     Load_xml.text_handler
 
-let () = 
-  Cduce_config.register 
-    "expat" 
+let () =
+  Cduce_config.register
+    "expat"
     "Expat XML parser"
     use
 
-let () = 
-  Schema_xml.xml_parser := 
+let () =
+  Schema_xml.xml_parser :=
     (fun uri f g -> load_expat f (fun _ -> g ()) (fun _ -> ()) uri)

runtime/cduce_pxp.ml

@@ -6,12 +6,12 @@ open Pxp_reader
 
 let pxp_handle_event = function
   | E_start_tag (name,att,_,_) -> Load_xml.start_element_handler name att
-  | E_char_data data -> Load_xml.text_handler data 
+  | E_char_data data -> Load_xml.text_handler data
   | E_end_tag (_,_) -> Load_xml.end_element_handler ()
   | _ -> ()
 
-let pxp_config = 
-  { default_config with 
+let pxp_config =
+  { default_config with
       (* warner = new warner; *)
       encoding = `Enc_utf8;
       store_element_positions = false;
@@ -41,8 +41,8 @@ let channel_of_id rid =
       | _, Some rel -> rel
       | _ -> raise Not_competent
   in
-  let enc,ch = 
-    if Cduce_url.is_url url 
+  let enc,ch =
+    if Cduce_url.is_url url
     then of_string (Cduce_url.load_url url)
     else of_file url
   in
@@ -55,23 +55,23 @@ let src_of_uri uri = XExtID (System uri,None,alt)
 let load_pxp handlers uri =
   try
     let mgr = create_entity_manager pxp_config (src_of_uri uri) in
-    process_entity pxp_config 
+    process_entity pxp_config
       (`Entry_document[`Extend_dtd_fully]) mgr handlers;
   with exn ->
     Value.failwith' (Pxp_types.string_of_exn exn)
 
 let use () = Load_xml.xml_parser := load_pxp pxp_handle_event
 
-let () = 
-  Cduce_config.register 
-    "pxp" 
+let () =
+  Cduce_config.register
+    "pxp"
     "PXP XML parser"
     use
 
-let () = 
-  Schema_xml.xml_parser := 
+let () =
+  Schema_xml.xml_parser :=
     (fun uri f g ->
-       load_pxp 
+       load_pxp
 	 (function
 	    | E_start_tag (name,att,_,_) -> f name att
 	    | E_end_tag (_,_) -> g ()