Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / setup.ml @ 54ae8ac7

History | View | Annotate | Download (154 KB)

1
(* setup.ml generated for the first time by OASIS v0.2.0 *)
2

    
3
(* OASIS_START *)
4
(* DO NOT EDIT (digest: 243f7ef4ca5fa7182acbe98e77d9c7f4) *)
5
(*
6
   Regenerated by OASIS v0.3.0
7
   Visit http://oasis.forge.ocamlcore.org for more information and
8
   documentation about functions used in this file.
9
*)
10
module OASISGettext = struct
11
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISGettext.ml" *)
12

    
13
  let ns_ str =
14
    str
15

    
16
  let s_ str =
17
    str
18

    
19
  let f_ (str : ('a, 'b, 'c, 'd) format4) =
20
    str
21

    
22
  let fn_ fmt1 fmt2 n =
23
    if n = 1 then
24
      fmt1^^""
25
    else
26
      fmt2^^""
27

    
28
  let init =
29
    []
30

    
31
end
32

    
33
module OASISContext = struct
34
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISContext.ml" *)
35

    
36
  open OASISGettext
37

    
38
  type level =
39
    [ `Debug
40
    | `Info
41
    | `Warning
42
    | `Error]
43

    
44
  type t =
45
    {
46
      quiet:                 bool;
47
      info:                  bool;
48
      debug:                 bool;
49
      ignore_plugins:        bool;
50
      ignore_unknown_fields: bool;
51
      printf:                level -> string -> unit;
52
    }
53

    
54
  let printf lvl str =
55
    let beg =
56
      match lvl with
57
        | `Error -> s_ "E: "
58
        | `Warning -> s_ "W: "
59
        | `Info  -> s_ "I: "
60
        | `Debug -> s_ "D: "
61
    in
62
      prerr_endline (beg^str)
63

    
64
  let default =
65
    ref
66
      {
67
        quiet                 = false;
68
        info                  = false;
69
        debug                 = false;
70
        ignore_plugins        = false;
71
        ignore_unknown_fields = false;
72
        printf                = printf;
73
      }
74

    
75
  let quiet =
76
    {!default with quiet = true}
77

    
78

    
79
  let args () =
80
    ["-quiet",
81
     Arg.Unit (fun () -> default := {!default with quiet = true}),
82
     (s_ " Run quietly");
83

    
84
     "-info",
85
     Arg.Unit (fun () -> default := {!default with info = true}),
86
     (s_ " Display information message");
87

    
88

    
89
     "-debug",
90
     Arg.Unit (fun () -> default := {!default with debug = true}),
91
     (s_ " Output debug message")]
92
end
93

    
94
module OASISString = struct
95
(* # 1 "/build/buildd/oasis-0.3.0/src/oasis/OASISString.ml" *)
96

    
97

    
98

    
99
  (** Various string utilities.
100
     
101
      Mostly inspired by extlib and batteries ExtString and BatString libraries.
102

    
103
      @author Sylvain Le Gall
104
    *)
105

    
106
  let nsplitf str f =
107
    if str = "" then
108
      []
109
    else
110
      let buf = Buffer.create 13 in
111
      let lst = ref [] in
112
      let push () =
113
        lst := Buffer.contents buf :: !lst;
114
        Buffer.clear buf
115
      in
116
      let str_len = String.length str in
117
        for i = 0 to str_len - 1 do
118
          if f str.[i] then
119
            push ()
120
          else
121
            Buffer.add_char buf str.[i]
122
        done;
123
        push ();
124
        List.rev !lst
125

    
126
  (** [nsplit c s] Split the string [s] at char [c]. It doesn't include the
127
      separator.
128
    *)
129
  let nsplit str c =
130
    nsplitf str ((=) c)
131

    
132
  let find ~what ?(offset=0) str =
133
    let what_idx = ref 0 in
134
    let str_idx = ref offset in 
135
      while !str_idx < String.length str && 
136
            !what_idx < String.length what do
137
        if str.[!str_idx] = what.[!what_idx] then
138
          incr what_idx
139
        else
140
          what_idx := 0;
141
        incr str_idx
142
      done;
143
      if !what_idx <> String.length what then
144
        raise Not_found
145
      else 
146
        !str_idx - !what_idx
147

    
148
  let sub_start str len = 
149
    let str_len = String.length str in
150
    if len >= str_len then
151
      ""
152
    else
153
      String.sub str len (str_len - len)
154

    
155
  let sub_end ?(offset=0) str len =
156
    let str_len = String.length str in
157
    if len >= str_len then
158
      ""
159
    else
160
      String.sub str 0 (str_len - len)
161

    
162
  let starts_with ~what ?(offset=0) str =
163
    let what_idx = ref 0 in
164
    let str_idx = ref offset in
165
    let ok = ref true in
166
      while !ok &&
167
            !str_idx < String.length str && 
168
            !what_idx < String.length what do
169
        if str.[!str_idx] = what.[!what_idx] then
170
          incr what_idx
171
        else
172
          ok := false;
173
        incr str_idx
174
      done;
175
      if !what_idx = String.length what then
176
        true
177
      else 
178
        false
179

    
180
  let strip_starts_with ~what str =
181
    if starts_with ~what str then
182
      sub_start str (String.length what)
183
    else
184
      raise Not_found
185

    
186
  let ends_with ~what ?(offset=0) str =
187
    let what_idx = ref ((String.length what) - 1) in
188
    let str_idx = ref ((String.length str) - 1) in
189
    let ok = ref true in
190
      while !ok &&
191
            offset <= !str_idx && 
192
            0 <= !what_idx do
193
        if str.[!str_idx] = what.[!what_idx] then
194
          decr what_idx
195
        else
196
          ok := false;
197
        decr str_idx
198
      done;
199
      if !what_idx = -1 then
200
        true
201
      else 
202
        false
203

    
204
  let strip_ends_with ~what str =
205
    if ends_with ~what str then
206
      sub_end str (String.length what)
207
    else
208
      raise Not_found
209

    
210
  let replace_chars f s =
211
    let buf = String.make (String.length s) 'X' in
212
      for i = 0 to String.length s - 1 do
213
        buf.[i] <- f s.[i]
214
      done;
215
      buf
216

    
217
end
218

    
219
module OASISUtils = struct
220
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISUtils.ml" *)
221

    
222
  open OASISGettext
223

    
224
  module MapString = Map.Make(String)
225

    
226
  let map_string_of_assoc assoc =
227
    List.fold_left
228
      (fun acc (k, v) -> MapString.add k v acc)
229
      MapString.empty
230
      assoc
231

    
232
  module SetString = Set.Make(String)
233

    
234
  let set_string_add_list st lst =
235
    List.fold_left
236
      (fun acc e -> SetString.add e acc)
237
      st
238
      lst
239

    
240
  let set_string_of_list =
241
    set_string_add_list
242
      SetString.empty
243

    
244

    
245
  let compare_csl s1 s2 =
246
    String.compare (String.lowercase s1) (String.lowercase s2)
247

    
248
  module HashStringCsl =
249
    Hashtbl.Make
250
      (struct
251
         type t = string
252

    
253
         let equal s1 s2 =
254
             (String.lowercase s1) = (String.lowercase s2)
255

    
256
         let hash s =
257
           Hashtbl.hash (String.lowercase s)
258
       end)
259

    
260
  let varname_of_string ?(hyphen='_') s =
261
    if String.length s = 0 then
262
      begin
263
        invalid_arg "varname_of_string"
264
      end
265
    else
266
      begin
267
        let buf =
268
          OASISString.replace_chars
269
            (fun c ->
270
               if ('a' <= c && c <= 'z')
271
                 ||
272
                  ('A' <= c && c <= 'Z')
273
                 ||
274
                  ('0' <= c && c <= '9') then
275
                 c
276
               else
277
                 hyphen)
278
            s;
279
        in
280
        let buf =
281
          (* Start with a _ if digit *)
282
          if '0' <= s.[0] && s.[0] <= '9' then
283
            "_"^buf
284
          else
285
            buf
286
        in
287
          String.lowercase buf
288
      end
289

    
290
  let varname_concat ?(hyphen='_') p s =
291
    let what = String.make 1 hyphen in
292
    let p =
293
      try
294
        OASISString.strip_ends_with ~what p
295
      with Not_found ->
296
        p
297
    in
298
    let s =
299
      try
300
        OASISString.strip_starts_with ~what s
301
      with Not_found ->
302
        s
303
    in
304
      p^what^s
305

    
306

    
307
  let is_varname str =
308
    str = varname_of_string str
309

    
310
  let failwithf fmt = Printf.ksprintf failwith fmt
311

    
312
end
313

    
314
module PropList = struct
315
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/PropList.ml" *)
316

    
317
  open OASISGettext
318

    
319
  type name = string
320

    
321
  exception Not_set of name * string option
322
  exception No_printer of name
323
  exception Unknown_field of name * name
324

    
325
  let () =
326
    Printexc.register_printer
327
      (function
328
         | Not_set (nm, Some rsn) ->
329
             Some 
330
               (Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn)
331
         | Not_set (nm, None) ->
332
             Some 
333
               (Printf.sprintf (f_ "Field '%s' is not set") nm)
334
         | No_printer nm ->
335
             Some
336
               (Printf.sprintf (f_ "No default printer for value %s") nm)
337
         | Unknown_field (nm, schm) ->
338
             Some 
339
               (Printf.sprintf (f_ "Field %s is not defined in schema %s") nm schm)
340
         | _ ->
341
             None)
342

    
343
  module Data =
344
  struct
345

    
346
    type t =
347
        (name, unit -> unit) Hashtbl.t
348

    
349
    let create () =
350
      Hashtbl.create 13
351

    
352
    let clear t =
353
      Hashtbl.clear t
354

    
355
(* # 71 "/build/buildd/oasis-0.3.0/src/oasis/PropList.ml" *)
356
  end
357

    
358
  module Schema =
359
  struct
360

    
361
    type ('ctxt, 'extra) value =
362
        {
363
          get:   Data.t -> string;
364
          set:   Data.t -> ?context:'ctxt -> string -> unit;
365
          help:  (unit -> string) option;
366
          extra: 'extra;
367
        }
368

    
369
    type ('ctxt, 'extra) t =
370
        {
371
          name:      name;
372
          fields:    (name, ('ctxt, 'extra) value) Hashtbl.t;
373
          order:     name Queue.t;
374
          name_norm: string -> string;
375
        }
376

    
377
    let create ?(case_insensitive=false) nm =
378
      {
379
        name      = nm;
380
        fields    = Hashtbl.create 13;
381
        order     = Queue.create ();
382
        name_norm =
383
          (if case_insensitive then
384
             String.lowercase
385
           else
386
             fun s -> s);
387
      }
388

    
389
    let add t nm set get extra help =
390
      let key =
391
        t.name_norm nm
392
      in
393

    
394
        if Hashtbl.mem t.fields key then
395
          failwith
396
            (Printf.sprintf
397
               (f_ "Field '%s' is already defined in schema '%s'")
398
               nm t.name);
399
        Hashtbl.add
400
          t.fields
401
          key
402
          {
403
            set   = set;
404
            get   = get;
405
            help  = help;
406
            extra = extra;
407
          };
408
        Queue.add nm t.order
409

    
410
    let mem t nm =
411
      Hashtbl.mem t.fields nm
412

    
413
    let find t nm =
414
      try
415
        Hashtbl.find t.fields (t.name_norm nm)
416
      with Not_found ->
417
        raise (Unknown_field (nm, t.name))
418

    
419
    let get t data nm =
420
      (find t nm).get data
421

    
422
    let set t data nm ?context x =
423
      (find t nm).set
424
        data
425
        ?context
426
        x
427

    
428
    let fold f acc t =
429
      Queue.fold
430
        (fun acc k ->
431
           let v =
432
             find t k
433
           in
434
             f acc k v.extra v.help)
435
        acc
436
        t.order
437

    
438
    let iter f t =
439
      fold
440
        (fun () -> f)
441
        ()
442
        t
443

    
444
    let name t =
445
      t.name
446
  end
447

    
448
  module Field =
449
  struct
450

    
451
    type ('ctxt, 'value, 'extra) t =
452
        {
453
          set:    Data.t -> ?context:'ctxt -> 'value -> unit;
454
          get:    Data.t -> 'value;
455
          sets:   Data.t -> ?context:'ctxt -> string -> unit;
456
          gets:   Data.t -> string;
457
          help:   (unit -> string) option;
458
          extra:  'extra;
459
        }
460

    
461
    let new_id =
462
      let last_id =
463
        ref 0
464
      in
465
        fun () -> incr last_id; !last_id
466

    
467
    let create ?schema ?name ?parse ?print ?default ?update ?help extra =
468
      (* Default value container *)
469
      let v =
470
        ref None
471
      in
472

    
473
      (* If name is not given, create unique one *)
474
      let nm =
475
        match name with
476
          | Some s -> s
477
          | None -> Printf.sprintf "_anon_%d" (new_id ())
478
      in
479

    
480
      (* Last chance to get a value: the default *)
481
      let default () =
482
        match default with
483
          | Some d -> d
484
          | None -> raise (Not_set (nm, Some (s_ "no default value")))
485
      in
486

    
487
      (* Get data *)
488
      let get data =
489
        (* Get value *)
490
        try
491
          (Hashtbl.find data nm) ();
492
          match !v with
493
            | Some x -> x
494
            | None -> default ()
495
        with Not_found ->
496
          default ()
497
      in
498

    
499
      (* Set data *)
500
      let set data ?context x =
501
        let x =
502
          match update with
503
            | Some f ->
504
                begin
505
                  try
506
                    f ?context (get data) x
507
                  with Not_set _ ->
508
                    x
509
                end
510
            | None ->
511
                x
512
        in
513
          Hashtbl.replace
514
            data
515
            nm
516
            (fun () -> v := Some x)
517
      in
518

    
519
      (* Parse string value, if possible *)
520
      let parse =
521
        match parse with
522
          | Some f ->
523
              f
524
          | None ->
525
              fun ?context s ->
526
                failwith
527
                  (Printf.sprintf
528
                     (f_ "Cannot parse field '%s' when setting value %S")
529
                     nm
530
                     s)
531
      in
532

    
533
      (* Set data, from string *)
534
      let sets data ?context s =
535
        set ?context data (parse ?context s)
536
      in
537

    
538
      (* Output value as string, if possible *)
539
      let print =
540
        match print with
541
          | Some f ->
542
              f
543
          | None ->
544
              fun _ -> raise (No_printer nm)
545
      in
546

    
547
      (* Get data, as a string *)
548
      let gets data =
549
        print (get data)
550
      in
551

    
552
        begin
553
          match schema with
554
            | Some t ->
555
                Schema.add t nm sets gets extra help
556
            | None ->
557
                ()
558
        end;
559

    
560
        {
561
          set   = set;
562
          get   = get;
563
          sets  = sets;
564
          gets  = gets;
565
          help  = help;
566
          extra = extra;
567
        }
568

    
569
    let fset data t ?context x =
570
      t.set data ?context x
571

    
572
    let fget data t =
573
      t.get data
574

    
575
    let fsets data t ?context s =
576
      t.sets data ?context s
577

    
578
    let fgets data t =
579
      t.gets data
580

    
581
  end
582

    
583
  module FieldRO =
584
  struct
585

    
586
    let create ?schema ?name ?parse ?print ?default ?update ?help extra =
587
      let fld =
588
        Field.create ?schema ?name ?parse ?print ?default ?update ?help extra
589
      in
590
        fun data -> Field.fget data fld
591

    
592
  end
593
end
594

    
595
module OASISMessage = struct
596
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISMessage.ml" *)
597

    
598

    
599
  open OASISGettext
600
  open OASISContext
601

    
602
  let generic_message ~ctxt lvl fmt =
603
    let cond =
604
      if ctxt.quiet then
605
        false
606
      else
607
        match lvl with
608
          | `Debug -> ctxt.debug
609
          | `Info  -> ctxt.info
610
          | _ -> true
611
    in
612
      Printf.ksprintf
613
        (fun str ->
614
           if cond then
615
             begin
616
               ctxt.printf lvl str
617
             end)
618
        fmt
619

    
620
  let debug ~ctxt fmt =
621
    generic_message ~ctxt `Debug fmt
622

    
623
  let info ~ctxt fmt =
624
    generic_message ~ctxt `Info fmt
625

    
626
  let warning ~ctxt fmt =
627
    generic_message ~ctxt `Warning fmt
628

    
629
  let error ~ctxt fmt =
630
    generic_message ~ctxt `Error fmt
631

    
632
end
633

    
634
module OASISVersion = struct
635
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISVersion.ml" *)
636

    
637
  open OASISGettext
638

    
639

    
640

    
641
  type s = string
642

    
643
  type t = string 
644

    
645
  type comparator =
646
    | VGreater of t
647
    | VGreaterEqual of t
648
    | VEqual of t
649
    | VLesser of t
650
    | VLesserEqual of t
651
    | VOr of  comparator * comparator
652
    | VAnd of comparator * comparator
653
    
654

    
655
  (* Range of allowed characters *)
656
  let is_digit c =
657
    '0' <= c && c <= '9'
658

    
659
  let is_alpha c =
660
    ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z')
661

    
662
  let is_special =
663
    function
664
      | '.' | '+' | '-' | '~' -> true
665
      | _ -> false
666

    
667
  let rec version_compare v1 v2 =
668
    if v1 <> "" || v2 <> "" then
669
      begin
670
        (* Compare ascii string, using special meaning for version
671
         * related char
672
         *)
673
        let val_ascii c =
674
          if c = '~' then -1
675
          else if is_digit c then 0
676
          else if c = '\000' then 0
677
          else if is_alpha c then Char.code c
678
          else (Char.code c) + 256
679
        in
680

    
681
        let len1 = String.length v1 in
682
        let len2 = String.length v2 in
683

    
684
        let p = ref 0 in
685

    
686
        (** Compare ascii part *)
687
        let compare_vascii () =
688
          let cmp = ref 0 in
689
          while !cmp = 0 &&
690
                !p < len1 && !p < len2 &&
691
                not (is_digit v1.[!p] && is_digit v2.[!p]) do
692
            cmp := (val_ascii v1.[!p]) - (val_ascii v2.[!p]);
693
            incr p
694
          done;
695
          if !cmp = 0 && !p < len1 && !p = len2 then
696
            val_ascii v1.[!p]
697
          else if !cmp = 0 && !p = len1 && !p < len2 then
698
            - (val_ascii v2.[!p])
699
          else
700
            !cmp
701
        in
702

    
703
        (** Compare digit part *)
704
        let compare_digit () =
705
          let extract_int v p =
706
            let start_p = !p in
707
              while !p < String.length v && is_digit v.[!p] do
708
                incr p
709
              done;
710
              let substr = 
711
                String.sub v !p ((String.length v) - !p)
712
              in 
713
              let res = 
714
                match String.sub v start_p (!p - start_p) with 
715
                  | "" -> 0
716
                  | s -> int_of_string s
717
              in
718
                res, substr
719
          in
720
          let i1, tl1 = extract_int v1 (ref !p) in
721
          let i2, tl2 = extract_int v2 (ref !p) in
722
            i1 - i2, tl1, tl2
723
        in
724

    
725
          match compare_vascii () with
726
            | 0 ->
727
                begin
728
                  match compare_digit () with
729
                    | 0, tl1, tl2 ->
730
                        if tl1 <> "" && is_digit tl1.[0] then
731
                          1
732
                        else if tl2 <> "" && is_digit tl2.[0] then
733
                          -1
734
                        else
735
                          version_compare tl1 tl2
736
                    | n, _, _ ->
737
                        n
738
                end
739
            | n ->
740
                n
741
      end
742
    else
743
      begin
744
        0
745
      end
746

    
747

    
748
  let version_of_string str = str
749

    
750
  let string_of_version t = t
751

    
752
  let chop t =
753
    try
754
      let pos =
755
        String.rindex t '.'
756
      in
757
        String.sub t 0 pos
758
    with Not_found ->
759
      t
760

    
761
  let rec comparator_apply v op =
762
    match op with
763
      | VGreater cv ->
764
          (version_compare v cv) > 0
765
      | VGreaterEqual cv ->
766
          (version_compare v cv) >= 0
767
      | VLesser cv ->
768
          (version_compare v cv) < 0
769
      | VLesserEqual cv ->
770
          (version_compare v cv) <= 0
771
      | VEqual cv ->
772
          (version_compare v cv) = 0
773
      | VOr (op1, op2) ->
774
          (comparator_apply v op1) || (comparator_apply v op2)
775
      | VAnd (op1, op2) ->
776
          (comparator_apply v op1) && (comparator_apply v op2)
777

    
778
  let rec string_of_comparator =
779
    function
780
      | VGreater v  -> "> "^(string_of_version v)
781
      | VEqual v    -> "= "^(string_of_version v)
782
      | VLesser v   -> "< "^(string_of_version v)
783
      | VGreaterEqual v -> ">= "^(string_of_version v)
784
      | VLesserEqual v  -> "<= "^(string_of_version v)
785
      | VOr (c1, c2)  ->
786
          (string_of_comparator c1)^" || "^(string_of_comparator c2)
787
      | VAnd (c1, c2) ->
788
          (string_of_comparator c1)^" && "^(string_of_comparator c2)
789

    
790
  let rec varname_of_comparator =
791
    let concat p v =
792
      OASISUtils.varname_concat
793
        p
794
        (OASISUtils.varname_of_string
795
           (string_of_version v))
796
    in
797
      function
798
        | VGreater v -> concat "gt" v
799
        | VLesser v  -> concat "lt" v
800
        | VEqual v   -> concat "eq" v
801
        | VGreaterEqual v -> concat "ge" v
802
        | VLesserEqual v  -> concat "le" v
803
        | VOr (c1, c2) ->
804
            (varname_of_comparator c1)^"_or_"^(varname_of_comparator c2)
805
        | VAnd (c1, c2) ->
806
            (varname_of_comparator c1)^"_and_"^(varname_of_comparator c2)
807

    
808
  let version_0_3_or_after t =
809
    comparator_apply t (VGreaterEqual (string_of_version "0.3"))
810

    
811
end
812

    
813
module OASISLicense = struct
814
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISLicense.ml" *)
815

    
816
  (** License for _oasis fields
817
      @author Sylvain Le Gall
818
    *)
819

    
820

    
821

    
822
  type license = string 
823

    
824
  type license_exception = string 
825

    
826
  type license_version =
827
    | Version of OASISVersion.t
828
    | VersionOrLater of OASISVersion.t
829
    | NoVersion
830
    
831

    
832
  type license_dep_5_unit =
833
    {
834
      license:   license;
835
      excption:  license_exception option;
836
      version:   license_version;
837
    }
838
    
839

    
840
  type license_dep_5 =
841
    | DEP5Unit of license_dep_5_unit
842
    | DEP5Or of license_dep_5 list
843
    | DEP5And of license_dep_5 list
844
    
845

    
846
  type t =
847
    | DEP5License of license_dep_5
848
    | OtherLicense of string (* URL *)
849
    
850

    
851
end
852

    
853
module OASISExpr = struct
854
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISExpr.ml" *)
855

    
856

    
857

    
858
  open OASISGettext
859

    
860
  type test = string 
861

    
862
  type flag = string 
863

    
864
  type t =
865
    | EBool of bool
866
    | ENot of t
867
    | EAnd of t * t
868
    | EOr of t * t
869
    | EFlag of flag
870
    | ETest of test * string
871
    
872

    
873
  type 'a choices = (t * 'a) list 
874

    
875
  let eval var_get t =
876
    let rec eval' =
877
      function
878
        | EBool b ->
879
            b
880

    
881
        | ENot e ->
882
            not (eval' e)
883

    
884
        | EAnd (e1, e2) ->
885
            (eval' e1) && (eval' e2)
886

    
887
        | EOr (e1, e2) ->
888
            (eval' e1) || (eval' e2)
889

    
890
        | EFlag nm ->
891
            let v =
892
              var_get nm
893
            in
894
              assert(v = "true" || v = "false");
895
              (v = "true")
896

    
897
        | ETest (nm, vl) ->
898
            let v =
899
              var_get nm
900
            in
901
              (v = vl)
902
    in
903
      eval' t
904

    
905
  let choose ?printer ?name var_get lst =
906
    let rec choose_aux =
907
      function
908
        | (cond, vl) :: tl ->
909
            if eval var_get cond then
910
              vl
911
            else
912
              choose_aux tl
913
        | [] ->
914
            let str_lst =
915
              if lst = [] then
916
                s_ "<empty>"
917
              else
918
                String.concat
919
                  (s_ ", ")
920
                  (List.map
921
                     (fun (cond, vl) ->
922
                        match printer with
923
                          | Some p -> p vl
924
                          | None -> s_ "<no printer>")
925
                     lst)
926
            in
927
              match name with
928
                | Some nm ->
929
                    failwith
930
                      (Printf.sprintf
931
                         (f_ "No result for the choice list '%s': %s")
932
                         nm str_lst)
933
                | None ->
934
                    failwith
935
                      (Printf.sprintf
936
                         (f_ "No result for a choice list: %s")
937
                         str_lst)
938
    in
939
      choose_aux (List.rev lst)
940

    
941
end
942

    
943
module OASISTypes = struct
944
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISTypes.ml" *)
945

    
946

    
947

    
948

    
949
  type name          = string 
950
  type package_name  = string 
951
  type url           = string 
952
  type unix_dirname  = string 
953
  type unix_filename = string 
954
  type host_dirname  = string 
955
  type host_filename = string 
956
  type prog          = string 
957
  type arg           = string 
958
  type args          = string list 
959
  type command_line  = (prog * arg list) 
960

    
961
  type findlib_name = string 
962
  type findlib_full = string 
963

    
964
  type compiled_object =
965
    | Byte
966
    | Native
967
    | Best
968
    
969

    
970
  type dependency =
971
    | FindlibPackage of findlib_full * OASISVersion.comparator option
972
    | InternalLibrary of name
973
    
974

    
975
  type tool =
976
    | ExternalTool of name
977
    | InternalExecutable of name
978
    
979

    
980
  type vcs =
981
    | Darcs
982
    | Git
983
    | Svn
984
    | Cvs
985
    | Hg
986
    | Bzr
987
    | Arch
988
    | Monotone
989
    | OtherVCS of url
990
    
991

    
992
  type plugin_kind =
993
      [  `Configure
994
       | `Build
995
       | `Doc
996
       | `Test
997
       | `Install
998
       | `Extra
999
      ]
1000

    
1001
  type plugin_data_purpose =
1002
      [  `Configure
1003
       | `Build
1004
       | `Install
1005
       | `Clean
1006
       | `Distclean
1007
       | `Install
1008
       | `Uninstall
1009
       | `Test
1010
       | `Doc
1011
       | `Extra
1012
       | `Other of string
1013
      ]
1014

    
1015
  type 'a plugin = 'a * name * OASISVersion.t option 
1016

    
1017
  type all_plugin = plugin_kind plugin
1018

    
1019
  type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list
1020

    
1021
(* # 102 "/build/buildd/oasis-0.3.0/src/oasis/OASISTypes.ml" *)
1022

    
1023
  type 'a conditional = 'a OASISExpr.choices 
1024

    
1025
  type custom =
1026
      {
1027
        pre_command:  (command_line option) conditional;
1028
        post_command: (command_line option) conditional;
1029
      }
1030
      
1031

    
1032
  type common_section =
1033
      {
1034
        cs_name: name;
1035
        cs_data: PropList.Data.t;
1036
        cs_plugin_data: plugin_data;
1037
      }
1038
      
1039

    
1040
  type build_section =
1041
      {
1042
        bs_build:           bool conditional;
1043
        bs_install:         bool conditional;
1044
        bs_path:            unix_dirname;
1045
        bs_compiled_object: compiled_object;
1046
        bs_build_depends:   dependency list;
1047
        bs_build_tools:     tool list;
1048
        bs_c_sources:       unix_filename list;
1049
        bs_data_files:      (unix_filename * unix_filename option) list;
1050
        bs_ccopt:           args conditional;
1051
        bs_cclib:           args conditional;
1052
        bs_dlllib:          args conditional;
1053
        bs_dllpath:         args conditional;
1054
        bs_byteopt:         args conditional;
1055
        bs_nativeopt:       args conditional;
1056
      }
1057
      
1058

    
1059
  type library =
1060
      {
1061
        lib_modules:            string list;
1062
        lib_pack:               bool;
1063
        lib_internal_modules:   string list;
1064
        lib_findlib_parent:     findlib_name option;
1065
        lib_findlib_name:       findlib_name option;
1066
        lib_findlib_containers: findlib_name list;
1067
      } 
1068

    
1069
  type executable =
1070
      {
1071
        exec_custom:          bool;
1072
        exec_main_is:         unix_filename;
1073
      } 
1074

    
1075
  type flag =
1076
      {
1077
        flag_description:  string option;
1078
        flag_default:      bool conditional;
1079
      } 
1080

    
1081
  type source_repository =
1082
      {
1083
        src_repo_type:        vcs;
1084
        src_repo_location:    url;
1085
        src_repo_browser:     url option;
1086
        src_repo_module:      string option;
1087
        src_repo_branch:      string option;
1088
        src_repo_tag:         string option;
1089
        src_repo_subdir:      unix_filename option;
1090
      } 
1091

    
1092
  type test =
1093
      {
1094
        test_type:               [`Test] plugin;
1095
        test_command:            command_line conditional;
1096
        test_custom:             custom;
1097
        test_working_directory:  unix_filename option;
1098
        test_run:                bool conditional;
1099
        test_tools:              tool list;
1100
      } 
1101

    
1102
  type doc_format =
1103
    | HTML of unix_filename
1104
    | DocText
1105
    | PDF
1106
    | PostScript
1107
    | Info of unix_filename
1108
    | DVI
1109
    | OtherDoc
1110
    
1111

    
1112
  type doc =
1113
      {
1114
        doc_type:        [`Doc] plugin;
1115
        doc_custom:      custom;
1116
        doc_build:       bool conditional;
1117
        doc_install:     bool conditional;
1118
        doc_install_dir: unix_filename;
1119
        doc_title:       string;
1120
        doc_authors:     string list;
1121
        doc_abstract:    string option;
1122
        doc_format:      doc_format;
1123
        doc_data_files:  (unix_filename * unix_filename option) list;
1124
        doc_build_tools: tool list;
1125
      } 
1126

    
1127
  type section =
1128
    | Library    of common_section * build_section * library
1129
    | Executable of common_section * build_section * executable
1130
    | Flag       of common_section * flag
1131
    | SrcRepo    of common_section * source_repository
1132
    | Test       of common_section * test
1133
    | Doc        of common_section * doc
1134
    
1135

    
1136
  type section_kind =
1137
      [ `Library | `Executable | `Flag | `SrcRepo | `Test | `Doc ]
1138

    
1139
  type package = 
1140
      {
1141
        oasis_version:    OASISVersion.t;
1142
        ocaml_version:    OASISVersion.comparator option;
1143
        findlib_version:  OASISVersion.comparator option;
1144
        name:             package_name;
1145
        version:          OASISVersion.t;
1146
        license:          OASISLicense.t;
1147
        license_file:     unix_filename option;
1148
        copyrights:       string list;
1149
        maintainers:      string list;
1150
        authors:          string list;
1151
        homepage:         url option;
1152
        synopsis:         string;
1153
        description:      string option;
1154
        categories:       url list;
1155

    
1156
        conf_type:        [`Configure] plugin;
1157
        conf_custom:      custom;
1158

    
1159
        build_type:       [`Build] plugin;
1160
        build_custom:     custom;
1161

    
1162
        install_type:     [`Install] plugin;
1163
        install_custom:   custom;
1164
        uninstall_custom: custom;
1165

    
1166
        clean_custom:     custom;
1167
        distclean_custom: custom;
1168

    
1169
        files_ab:         unix_filename list;
1170
        sections:         section list;
1171
        plugins:          [`Extra] plugin list;
1172
        schema_data:      PropList.Data.t;
1173
        plugin_data:      plugin_data;
1174
      } 
1175

    
1176
end
1177

    
1178
module OASISUnixPath = struct
1179
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISUnixPath.ml" *)
1180

    
1181
  type unix_filename = string
1182
  type unix_dirname = string
1183

    
1184
  type host_filename = string
1185
  type host_dirname = string
1186

    
1187
  let current_dir_name = "."
1188

    
1189
  let parent_dir_name = ".."
1190

    
1191
  let is_current_dir fn =
1192
    fn = current_dir_name || fn = ""
1193

    
1194
  let concat f1 f2 =
1195
    if is_current_dir f1 then
1196
      f2
1197
    else
1198
      let f1' =
1199
        try OASISString.strip_ends_with ~what:"/" f1 with Not_found -> f1
1200
      in
1201
        f1'^"/"^f2
1202

    
1203
  let make =
1204
    function
1205
      | hd :: tl ->
1206
          List.fold_left
1207
            (fun f p -> concat f p)
1208
            hd
1209
            tl
1210
      | [] ->
1211
          invalid_arg "OASISUnixPath.make"
1212

    
1213
  let dirname f =
1214
    try
1215
      String.sub f 0 (String.rindex f '/')
1216
    with Not_found ->
1217
      current_dir_name
1218

    
1219
  let basename f =
1220
    try
1221
      let pos_start =
1222
        (String.rindex f '/') + 1
1223
      in
1224
        String.sub f pos_start ((String.length f) - pos_start)
1225
    with Not_found ->
1226
      f
1227

    
1228
  let chop_extension f =
1229
    try
1230
      let last_dot =
1231
        String.rindex f '.'
1232
      in
1233
      let sub =
1234
        String.sub f 0 last_dot
1235
      in
1236
        try
1237
          let last_slash =
1238
            String.rindex f '/'
1239
          in
1240
            if last_slash < last_dot then
1241
              sub
1242
            else
1243
              f
1244
        with Not_found ->
1245
          sub
1246

    
1247
    with Not_found ->
1248
      f
1249

    
1250
  let capitalize_file f =
1251
    let dir = dirname f in
1252
    let base = basename f in
1253
    concat dir (String.capitalize base)
1254

    
1255
  let uncapitalize_file f =
1256
    let dir = dirname f in
1257
    let base = basename f in
1258
    concat dir (String.uncapitalize base)
1259

    
1260
end
1261

    
1262
module OASISHostPath = struct
1263
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISHostPath.ml" *)
1264

    
1265

    
1266
  open Filename
1267

    
1268
  module Unix = OASISUnixPath
1269

    
1270
  let make =
1271
    function
1272
      | [] ->
1273
          invalid_arg "OASISHostPath.make"
1274
      | hd :: tl ->
1275
          List.fold_left Filename.concat hd tl
1276

    
1277
  let of_unix ufn =
1278
    if Sys.os_type = "Unix" then
1279
      ufn
1280
    else
1281
      make
1282
        (List.map
1283
           (fun p ->
1284
              if p = Unix.current_dir_name then
1285
                current_dir_name
1286
              else if p = Unix.parent_dir_name then
1287
                parent_dir_name
1288
              else
1289
                p)
1290
           (OASISString.nsplit ufn '/'))
1291

    
1292

    
1293
end
1294

    
1295
module OASISSection = struct
1296
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISSection.ml" *)
1297

    
1298
  open OASISTypes
1299

    
1300
  let section_kind_common = 
1301
    function
1302
      | Library (cs, _, _) -> 
1303
          `Library, cs
1304
      | Executable (cs, _, _) ->
1305
          `Executable, cs
1306
      | Flag (cs, _) ->
1307
          `Flag, cs
1308
      | SrcRepo (cs, _) ->
1309
          `SrcRepo, cs
1310
      | Test (cs, _) ->
1311
          `Test, cs
1312
      | Doc (cs, _) ->
1313
          `Doc, cs
1314

    
1315
  let section_common sct =
1316
    snd (section_kind_common sct)
1317

    
1318
  let section_common_set cs =
1319
    function
1320
      | Library (_, bs, lib)     -> Library (cs, bs, lib)
1321
      | Executable (_, bs, exec) -> Executable (cs, bs, exec)
1322
      | Flag (_, flg)            -> Flag (cs, flg)
1323
      | SrcRepo (_, src_repo)    -> SrcRepo (cs, src_repo)
1324
      | Test (_, tst)            -> Test (cs, tst)
1325
      | Doc (_, doc)             -> Doc (cs, doc)
1326

    
1327
  (** Key used to identify section
1328
    *)
1329
  let section_id sct = 
1330
    let k, cs = 
1331
      section_kind_common sct
1332
    in
1333
      k, cs.cs_name
1334

    
1335
  let string_of_section sct =
1336
    let k, nm =
1337
      section_id sct
1338
    in
1339
      (match k with
1340
         | `Library    -> "library" 
1341
         | `Executable -> "executable"
1342
         | `Flag       -> "flag"
1343
         | `SrcRepo    -> "src repository"
1344
         | `Test       -> "test"
1345
         | `Doc        -> "doc")
1346
      ^" "^nm
1347

    
1348
  let section_find id scts =
1349
    List.find
1350
      (fun sct -> id = section_id sct)
1351
      scts
1352

    
1353
  module CSection =
1354
  struct
1355
    type t = section
1356

    
1357
    let id = section_id
1358

    
1359
    let compare t1 t2 = 
1360
      compare (id t1) (id t2)
1361
      
1362
    let equal t1 t2 =
1363
      (id t1) = (id t2)
1364

    
1365
    let hash t =
1366
      Hashtbl.hash (id t)
1367
  end
1368

    
1369
  module MapSection = Map.Make(CSection)
1370
  module SetSection = Set.Make(CSection)
1371

    
1372
end
1373

    
1374
module OASISBuildSection = struct
1375
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISBuildSection.ml" *)
1376

    
1377
end
1378

    
1379
module OASISExecutable = struct
1380
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISExecutable.ml" *)
1381

    
1382
  open OASISTypes
1383

    
1384
  let unix_exec_is (cs, bs, exec) is_native ext_dll suffix_program = 
1385
    let dir = 
1386
      OASISUnixPath.concat
1387
        bs.bs_path
1388
        (OASISUnixPath.dirname exec.exec_main_is)
1389
    in
1390
    let is_native_exec = 
1391
      match bs.bs_compiled_object with
1392
        | Native -> true
1393
        | Best -> is_native ()
1394
        | Byte -> false
1395
    in
1396

    
1397
      OASISUnixPath.concat
1398
        dir
1399
        (cs.cs_name^(suffix_program ())),
1400

    
1401
      if not is_native_exec && 
1402
         not exec.exec_custom && 
1403
         bs.bs_c_sources <> [] then
1404
        Some (dir^"/dll"^cs.cs_name^"_stubs"^(ext_dll ()))
1405
      else
1406
        None
1407

    
1408
end
1409

    
1410
module OASISLibrary = struct
1411
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISLibrary.ml" *)
1412

    
1413
  open OASISTypes
1414
  open OASISUtils
1415
  open OASISGettext
1416
  open OASISSection
1417

    
1418
  type library_name = name
1419
  type findlib_part_name = name
1420
  type 'a map_of_findlib_part_name = 'a OASISUtils.MapString.t
1421

    
1422
  exception InternalLibraryNotFound of library_name
1423
  exception FindlibPackageNotFound of findlib_name
1424

    
1425
  type group_t =
1426
    | Container of findlib_name * group_t list
1427
    | Package of (findlib_name *
1428
                  common_section *
1429
                  build_section *
1430
                  library *
1431
                  group_t list)
1432

    
1433
  (* Look for a module file, considering capitalization or not. *)
1434
  let find_module source_file_exists (cs, bs, lib) modul =
1435
    let possible_base_fn =
1436
      List.map
1437
        (OASISUnixPath.concat bs.bs_path)
1438
        [modul;
1439
         OASISUnixPath.uncapitalize_file modul;
1440
         OASISUnixPath.capitalize_file modul]
1441
    in
1442
      (* TODO: we should be able to be able to determine the source for every
1443
       * files. Hence we should introduce a Module(source: fn) for the fields
1444
       * Modules and InternalModules
1445
       *)
1446
      List.fold_left
1447
        (fun acc base_fn ->
1448
           match acc with
1449
             | `No_sources _ ->
1450
                 begin
1451
                   let file_found =
1452
                     List.fold_left
1453
                       (fun acc ext ->
1454
                          if source_file_exists (base_fn^ext) then
1455
                            (base_fn^ext) :: acc
1456
                          else
1457
                            acc)
1458
                       []
1459
                       [".ml"; ".mli"; ".mll"; ".mly"]
1460
                   in
1461
                     match file_found with
1462
                       | [] ->
1463
                           acc
1464
                       | lst ->
1465
                           `Sources (base_fn, lst)
1466
                 end
1467
             | `Sources _ ->
1468
                 acc)
1469
        (`No_sources possible_base_fn)
1470
        possible_base_fn
1471

    
1472
  let source_unix_files ~ctxt (cs, bs, lib) source_file_exists =
1473
    List.fold_left
1474
      (fun acc modul ->
1475
         match find_module source_file_exists (cs, bs, lib) modul with
1476
           | `Sources (base_fn, lst) ->
1477
               (base_fn, lst) :: acc
1478
           | `No_sources _ ->
1479
               OASISMessage.warning
1480
                 ~ctxt
1481
                 (f_ "Cannot find source file matching \
1482
                      module '%s' in library %s")
1483
                 modul cs.cs_name;
1484
               acc)
1485
      []
1486
      (lib.lib_modules @ lib.lib_internal_modules)
1487

    
1488
  let generated_unix_files
1489
        ~ctxt
1490
        ~is_native
1491
        ~has_native_dynlink
1492
        ~ext_lib
1493
        ~ext_dll
1494
        ~source_file_exists
1495
        (cs, bs, lib) =
1496

    
1497
    let find_modules lst ext = 
1498
      let find_module modul =
1499
        match find_module source_file_exists (cs, bs, lib) modul with
1500
          | `Sources (base_fn, _) ->
1501
              [base_fn]
1502
          | `No_sources lst ->
1503
              OASISMessage.warning
1504
                ~ctxt
1505
                (f_ "Cannot find source file matching \
1506
                     module '%s' in library %s")
1507
                modul cs.cs_name;
1508
              lst
1509
      in
1510
      List.map 
1511
        (fun nm -> 
1512
           List.map 
1513
             (fun base_fn -> base_fn ^"."^ext)
1514
             (find_module nm))
1515
        lst
1516
    in
1517

    
1518
    (* The headers that should be compiled along *)
1519
    let headers =
1520
      if lib.lib_pack then
1521
        []
1522
      else
1523
        find_modules
1524
          lib.lib_modules
1525
          "cmi"
1526
    in
1527

    
1528
    (* The .cmx that be compiled along *)
1529
    let cmxs =
1530
      let should_be_built =
1531
        (not lib.lib_pack) && (* Do not install .cmx packed submodules *)
1532
        match bs.bs_compiled_object with
1533
          | Native -> true
1534
          | Best -> is_native
1535
          | Byte -> false
1536
      in
1537
        if should_be_built then
1538
          find_modules
1539
            (lib.lib_modules @ lib.lib_internal_modules)
1540
            "cmx"
1541
        else
1542
          []
1543
    in
1544

    
1545
    let acc_nopath =
1546
      []
1547
    in
1548

    
1549
    (* Compute what libraries should be built *)
1550
    let acc_nopath =
1551
      (* Add the packed header file if required *)
1552
      let add_pack_header acc =
1553
        if lib.lib_pack then
1554
          [cs.cs_name^".cmi"] :: acc
1555
        else
1556
          acc
1557
      in
1558
      let byte acc =
1559
        add_pack_header ([cs.cs_name^".cma"] :: acc)
1560
      in
1561
      let native acc =
1562
        let acc = 
1563
          add_pack_header
1564
            (if has_native_dynlink then
1565
               [cs.cs_name^".cmxs"] :: acc
1566
             else acc)
1567
        in
1568
          [cs.cs_name^".cmxa"] :: [cs.cs_name^ext_lib] :: acc
1569
      in
1570
        match bs.bs_compiled_object with
1571
          | Native ->
1572
              byte (native acc_nopath)
1573
          | Best when is_native ->
1574
              byte (native acc_nopath)
1575
          | Byte | Best ->
1576
              byte acc_nopath
1577
    in
1578

    
1579
    (* Add C library to be built *)
1580
    let acc_nopath =
1581
      if bs.bs_c_sources <> [] then
1582
        begin
1583
          ["lib"^cs.cs_name^"_stubs"^ext_lib]
1584
          ::
1585
          ["dll"^cs.cs_name^"_stubs"^ext_dll]
1586
          ::
1587
          acc_nopath
1588
        end
1589
      else
1590
        acc_nopath
1591
    in
1592

    
1593
      (* All the files generated *)
1594
      List.rev_append
1595
        (List.rev_map
1596
           (List.rev_map
1597
              (OASISUnixPath.concat bs.bs_path))
1598
           acc_nopath)
1599
        (headers @ cmxs)
1600

    
1601
  type data = common_section * build_section * library
1602
  type tree =
1603
    | Node of (data option) * (tree MapString.t)
1604
    | Leaf of data
1605

    
1606
  let findlib_mapping pkg =
1607
    (* Map from library name to either full findlib name or parts + parent. *)
1608
    let fndlb_parts_of_lib_name =
1609
      let fndlb_parts cs lib =
1610
        let name =
1611
          match lib.lib_findlib_name with
1612
            | Some nm -> nm
1613
            | None -> cs.cs_name
1614
        in
1615
        let name =
1616
          String.concat "." (lib.lib_findlib_containers @ [name])
1617
        in
1618
          name
1619
      in
1620
        List.fold_left
1621
          (fun mp ->
1622
             function
1623
               | Library (cs, _, lib) ->
1624
                   begin
1625
                     let lib_name = cs.cs_name in
1626
                     let fndlb_parts = fndlb_parts cs lib in
1627
                       if MapString.mem lib_name mp then
1628
                         failwithf
1629
                           (f_ "The library name '%s' is used more than once.")
1630
                           lib_name;
1631
                       match lib.lib_findlib_parent with
1632
                         | Some lib_name_parent ->
1633
                             MapString.add
1634
                               lib_name
1635
                               (`Unsolved (lib_name_parent, fndlb_parts))
1636
                               mp
1637
                         | None ->
1638
                             MapString.add
1639
                               lib_name
1640
                               (`Solved fndlb_parts)
1641
                               mp
1642
                   end
1643

    
1644
               | Executable _ | Test _ | Flag _ | SrcRepo _ | Doc _ ->
1645
                   mp)
1646
          MapString.empty
1647
          pkg.sections
1648
    in
1649

    
1650
    (* Solve the above graph to be only library name to full findlib name. *)
1651
    let fndlb_name_of_lib_name =
1652
      let rec solve visited mp lib_name lib_name_child =
1653
        if SetString.mem lib_name visited then
1654
          failwithf
1655
            (f_ "Library '%s' is involved in a cycle \
1656
                 with regard to findlib naming.")
1657
            lib_name;
1658
        let visited = SetString.add lib_name visited in
1659
          try
1660
            match MapString.find lib_name mp with
1661
              | `Solved fndlb_nm ->
1662
                  fndlb_nm, mp
1663
              | `Unsolved (lib_nm_parent, post_fndlb_nm) ->
1664
                  let pre_fndlb_nm, mp =
1665
                    solve visited mp lib_nm_parent lib_name
1666
                  in
1667
                  let fndlb_nm = pre_fndlb_nm^"."^post_fndlb_nm in
1668
                    fndlb_nm, MapString.add lib_name (`Solved fndlb_nm) mp
1669
          with Not_found ->
1670
            failwithf
1671
              (f_ "Library '%s', which is defined as the findlib parent of \
1672
                   library '%s', doesn't exist.")
1673
              lib_name lib_name_child
1674
      in
1675
      let mp =
1676
        MapString.fold
1677
          (fun lib_name status mp ->
1678
             match status with
1679
               | `Solved _ ->
1680
                   (* Solved initialy, no need to go further *)
1681
                   mp
1682
               | `Unsolved _ ->
1683
                   let _, mp = solve SetString.empty mp lib_name "<none>" in
1684
                     mp)
1685
          fndlb_parts_of_lib_name
1686
          fndlb_parts_of_lib_name
1687
      in
1688
        MapString.map
1689
          (function
1690
             | `Solved fndlb_nm -> fndlb_nm
1691
             | `Unsolved _ -> assert false)
1692
          mp
1693
    in
1694

    
1695
    (* Convert an internal library name to a findlib name. *)
1696
    let findlib_name_of_library_name lib_nm =
1697
      try
1698
        MapString.find lib_nm fndlb_name_of_lib_name
1699
      with Not_found ->
1700
        raise (InternalLibraryNotFound lib_nm)
1701
    in
1702

    
1703
    (* Add a library to the tree.
1704
     *)
1705
    let add sct mp =
1706
      let fndlb_fullname =
1707
        let cs, _, _ = sct in
1708
        let lib_name = cs.cs_name in
1709
          findlib_name_of_library_name lib_name
1710
      in
1711
      let rec add_children nm_lst (children : tree MapString.t) =
1712
        match nm_lst with
1713
          | (hd :: tl) ->
1714
              begin
1715
                let node =
1716
                  try
1717
                    add_node tl (MapString.find hd children)
1718
                  with Not_found ->
1719
                    (* New node *)
1720
                    new_node tl
1721
                in
1722
                  MapString.add hd node children
1723
              end
1724
          | [] ->
1725
              (* Should not have a nameless library. *)
1726
              assert false
1727
      and add_node tl node =
1728
        if tl = [] then
1729
          begin
1730
            match node with
1731
              | Node (None, children) ->
1732
                  Node (Some sct, children)
1733
              | Leaf (cs', _, _) | Node (Some (cs', _, _), _) ->
1734
                  (* TODO: allow to merge Package, i.e.
1735
                   * archive(byte) = "foo.cma foo_init.cmo"
1736
                   *)
1737
                  let cs, _, _ = sct in
1738
                    failwithf
1739
                      (f_ "Library '%s' and '%s' have the same findlib name '%s'")
1740
                      cs.cs_name cs'.cs_name fndlb_fullname
1741
          end
1742
        else
1743
          begin
1744
            match node with
1745
              | Leaf data ->
1746
                  Node (Some data, add_children tl MapString.empty)
1747
              | Node (data_opt, children) ->
1748
                  Node (data_opt, add_children tl children)
1749
          end
1750
      and new_node =
1751
        function
1752
          | [] ->
1753
              Leaf sct
1754
          | hd :: tl ->
1755
              Node (None, MapString.add hd (new_node tl) MapString.empty)
1756
      in
1757
        add_children (OASISString.nsplit fndlb_fullname '.') mp
1758
    in
1759

    
1760
    let rec group_of_tree mp =
1761
      MapString.fold
1762
        (fun nm node acc ->
1763
           let cur =
1764
             match node with
1765
               | Node (Some (cs, bs, lib), children) ->
1766
                   Package (nm, cs, bs, lib, group_of_tree children)
1767
               | Node (None, children) ->
1768
                   Container (nm, group_of_tree children)
1769
               | Leaf (cs, bs, lib) ->
1770
                   Package (nm, cs, bs, lib, [])
1771
           in
1772
             cur :: acc)
1773
        mp []
1774
    in
1775

    
1776
    let group_mp =
1777
      List.fold_left
1778
        (fun mp ->
1779
           function
1780
             | Library (cs, bs, lib) ->
1781
                 add (cs, bs, lib) mp
1782
             | _ ->
1783
                 mp)
1784
        MapString.empty
1785
        pkg.sections
1786
    in
1787

    
1788
    let groups =
1789
      group_of_tree group_mp
1790
    in
1791

    
1792
    let library_name_of_findlib_name =
1793
      Lazy.lazy_from_fun
1794
        (fun () ->
1795
           (* Revert findlib_name_of_library_name. *)
1796
           MapString.fold
1797
             (fun k v mp -> MapString.add v k mp)
1798
             fndlb_name_of_lib_name
1799
             MapString.empty)
1800
    in
1801
    let library_name_of_findlib_name fndlb_nm =
1802
      try
1803
        MapString.find fndlb_nm (Lazy.force library_name_of_findlib_name)
1804
      with Not_found ->
1805
        raise (FindlibPackageNotFound fndlb_nm)
1806
    in
1807

    
1808
      groups,
1809
      findlib_name_of_library_name,
1810
      library_name_of_findlib_name
1811

    
1812
  let findlib_of_group =
1813
    function
1814
      | Container (fndlb_nm, _)
1815
      | Package (fndlb_nm, _, _, _, _) -> fndlb_nm
1816

    
1817
  let root_of_group grp =
1818
    let rec root_lib_aux =
1819
      (* We do a DFS in the group. *)
1820
      function
1821
        | Container (_, children) ->
1822
            List.fold_left
1823
              (fun res grp ->
1824
                 if res = None then
1825
                   root_lib_aux grp
1826
                 else
1827
                   res)
1828
              None
1829
              children
1830
        | Package (_, cs, bs, lib, _) ->
1831
            Some (cs, bs, lib)
1832
    in
1833
      match root_lib_aux grp with
1834
        | Some res ->
1835
            res
1836
        | None ->
1837
            failwithf
1838
              (f_ "Unable to determine root library of findlib library '%s'")
1839
              (findlib_of_group grp)
1840

    
1841
end
1842

    
1843
module OASISFlag = struct
1844
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISFlag.ml" *)
1845

    
1846
end
1847

    
1848
module OASISPackage = struct
1849
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISPackage.ml" *)
1850

    
1851
end
1852

    
1853
module OASISSourceRepository = struct
1854
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISSourceRepository.ml" *)
1855

    
1856
end
1857

    
1858
module OASISTest = struct
1859
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISTest.ml" *)
1860

    
1861
end
1862

    
1863
module OASISDocument = struct
1864
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISDocument.ml" *)
1865

    
1866
end
1867

    
1868
module OASISExec = struct
1869
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISExec.ml" *)
1870

    
1871
  open OASISGettext
1872
  open OASISUtils
1873
  open OASISMessage
1874

    
1875
  (* TODO: I don't like this quote, it is there because $(rm) foo expands to
1876
   * 'rm -f' foo...
1877
   *)
1878
  let run ~ctxt ?f_exit_code ?(quote=true) cmd args =
1879
    let cmd =
1880
      if quote then
1881
        if Sys.os_type = "Win32" then
1882
          if String.contains cmd ' ' then
1883
            (* Double the 1st double quote... win32... sigh *)
1884
            "\""^(Filename.quote cmd)
1885
          else
1886
            cmd
1887
        else
1888
          Filename.quote cmd
1889
      else
1890
        cmd
1891
    in
1892
    let cmdline =
1893
      String.concat " " (cmd :: args)
1894
    in
1895
      info ~ctxt (f_ "Running command '%s'") cmdline;
1896
      match f_exit_code, Sys.command cmdline with
1897
        | None, 0 -> ()
1898
        | None, i ->
1899
            failwithf
1900
              (f_ "Command '%s' terminated with error code %d")
1901
              cmdline i
1902
        | Some f, i ->
1903
            f i
1904

    
1905
  let run_read_output ~ctxt ?f_exit_code cmd args =
1906
    let fn =
1907
      Filename.temp_file "oasis-" ".txt"
1908
    in
1909
      try
1910
        begin
1911
          let () =
1912
            run ~ctxt ?f_exit_code cmd (args @ [">"; Filename.quote fn])
1913
          in
1914
          let chn =
1915
            open_in fn
1916
          in
1917
          let routput =
1918
            ref []
1919
          in
1920
            begin
1921
              try
1922
                while true do
1923
                  routput := (input_line chn) :: !routput
1924
                done
1925
              with End_of_file ->
1926
                ()
1927
            end;
1928
            close_in chn;
1929
            Sys.remove fn;
1930
            List.rev !routput
1931
        end
1932
      with e ->
1933
        (try Sys.remove fn with _ -> ());
1934
        raise e
1935

    
1936
  let run_read_one_line ~ctxt ?f_exit_code cmd args =
1937
    match run_read_output ~ctxt ?f_exit_code cmd args with
1938
      | [fst] ->
1939
          fst
1940
      | lst ->
1941
          failwithf
1942
            (f_ "Command return unexpected output %S")
1943
            (String.concat "\n" lst)
1944
end
1945

    
1946
module OASISFileUtil = struct
1947
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISFileUtil.ml" *)
1948

    
1949
  open OASISGettext
1950

    
1951
  let file_exists_case fn =
1952
    let dirname = Filename.dirname fn in
1953
    let basename = Filename.basename fn in
1954
      if Sys.file_exists dirname then
1955
        if basename = Filename.current_dir_name then
1956
          true
1957
        else
1958
          List.mem
1959
            basename
1960
            (Array.to_list (Sys.readdir dirname))
1961
      else
1962
        false
1963

    
1964
  let find_file ?(case_sensitive=true) paths exts =
1965

    
1966
    (* Cardinal product of two list *)
1967
    let ( * ) lst1 lst2 =
1968
      List.flatten
1969
        (List.map
1970
           (fun a ->
1971
              List.map
1972
                (fun b -> a,b)
1973
                lst2)
1974
           lst1)
1975
    in
1976

    
1977
    let rec combined_paths lst =
1978
      match lst with
1979
        | p1 :: p2 :: tl ->
1980
            let acc =
1981
              (List.map
1982
                 (fun (a,b) -> Filename.concat a b)
1983
                 (p1 * p2))
1984
            in
1985
              combined_paths (acc :: tl)
1986
        | [e] ->
1987
            e
1988
        | [] ->
1989
            []
1990
    in
1991

    
1992
    let alternatives =
1993
      List.map
1994
        (fun (p,e) ->
1995
           if String.length e > 0 && e.[0] <> '.' then
1996
             p ^ "." ^ e
1997
           else
1998
             p ^ e)
1999
        ((combined_paths paths) * exts)
2000
    in
2001
      List.find
2002
        (if case_sensitive then
2003
           file_exists_case
2004
         else
2005
           Sys.file_exists)
2006
        alternatives
2007

    
2008
  let which ~ctxt prg =
2009
    let path_sep =
2010
      match Sys.os_type with
2011
        | "Win32" ->
2012
            ';'
2013
        | _ ->
2014
            ':'
2015
    in
2016
    let path_lst = OASISString.nsplit (Sys.getenv "PATH") path_sep in
2017
    let exec_ext =
2018
      match Sys.os_type with
2019
        | "Win32" ->
2020
            "" :: (OASISString.nsplit (Sys.getenv "PATHEXT") path_sep)
2021
        | _ ->
2022
            [""]
2023
    in
2024
      find_file ~case_sensitive:false [path_lst; [prg]] exec_ext
2025

    
2026
  (**/**)
2027
  let rec fix_dir dn =
2028
    (* Windows hack because Sys.file_exists "src\\" = false when
2029
     * Sys.file_exists "src" = true
2030
     *)
2031
    let ln =
2032
      String.length dn
2033
    in
2034
      if Sys.os_type = "Win32" && ln > 0 && dn.[ln - 1] = '\\' then
2035
        fix_dir (String.sub dn 0 (ln - 1))
2036
      else
2037
        dn
2038

    
2039
  let q = Filename.quote
2040
  (**/**)
2041

    
2042
  let cp ~ctxt ?(recurse=false) src tgt =
2043
    if recurse then
2044
      match Sys.os_type with
2045
        | "Win32" ->
2046
            OASISExec.run ~ctxt
2047
              "xcopy" [q src; q tgt; "/E"]
2048
        | _ ->
2049
            OASISExec.run ~ctxt
2050
              "cp" ["-r"; q src; q tgt]
2051
    else
2052
      OASISExec.run ~ctxt
2053
        (match Sys.os_type with
2054
         | "Win32" -> "copy"
2055
         | _ -> "cp")
2056
        [q src; q tgt]
2057

    
2058
  let mkdir ~ctxt tgt =
2059
    OASISExec.run ~ctxt
2060
      (match Sys.os_type with
2061
         | "Win32" -> "md"
2062
         | _ -> "mkdir")
2063
      [q tgt]
2064

    
2065
  let rec mkdir_parent ~ctxt f tgt =
2066
    let tgt =
2067
      fix_dir tgt
2068
    in
2069
      if Sys.file_exists tgt then
2070
        begin
2071
          if not (Sys.is_directory tgt) then
2072
            OASISUtils.failwithf
2073
              (f_ "Cannot create directory '%s', a file of the same name already \
2074
                   exists")
2075
              tgt
2076
        end
2077
      else
2078
        begin
2079
          mkdir_parent ~ctxt f (Filename.dirname tgt);
2080
          if not (Sys.file_exists tgt) then
2081
            begin
2082
              f tgt;
2083
              mkdir ~ctxt tgt
2084
            end
2085
        end
2086

    
2087
  let rmdir ~ctxt tgt =
2088
    if Sys.readdir tgt = [||] then
2089
      begin
2090
        match Sys.os_type with
2091
          | "Win32" ->
2092
              OASISExec.run ~ctxt "rd" [q tgt]
2093
          | _ ->
2094
              OASISExec.run ~ctxt "rm" ["-r"; q tgt]
2095
      end
2096

    
2097
  let glob ~ctxt fn =
2098
   let basename =
2099
     Filename.basename fn
2100
   in
2101
     if String.length basename >= 2 &&
2102
        basename.[0] = '*' &&
2103
        basename.[1] = '.' then
2104
       begin
2105
         let ext_len =
2106
           (String.length basename) - 2
2107
         in
2108
         let ext =
2109
           String.sub basename 2 ext_len
2110
         in
2111
         let dirname =
2112
           Filename.dirname fn
2113
         in
2114
           Array.fold_left
2115
             (fun acc fn ->
2116
                try
2117
                  let fn_ext =
2118
                    String.sub
2119
                      fn
2120
                      ((String.length fn) - ext_len)
2121
                      ext_len
2122
                  in
2123
                    if fn_ext = ext then
2124
                      (Filename.concat dirname fn) :: acc
2125
                    else
2126
                      acc
2127
                with Invalid_argument _ ->
2128
                  acc)
2129
             []
2130
             (Sys.readdir dirname)
2131
       end
2132
     else
2133
       begin
2134
         if file_exists_case fn then
2135
           [fn]
2136
         else
2137
           []
2138
       end
2139
end
2140

    
2141

    
2142
# 2142 "setup.ml"
2143
module BaseEnvLight = struct
2144
(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseEnvLight.ml" *)
2145

    
2146
  module MapString = Map.Make(String)
2147

    
2148
  type t = string MapString.t
2149

    
2150
  let default_filename =
2151
    Filename.concat
2152
      (Sys.getcwd ())
2153
      "setup.data"
2154

    
2155
  let load ?(allow_empty=false) ?(filename=default_filename) () =
2156
    if Sys.file_exists filename then
2157
      begin
2158
        let chn =
2159
          open_in_bin filename
2160
        in
2161
        let st =
2162
          Stream.of_channel chn
2163
        in
2164
        let line =
2165
          ref 1
2166
        in
2167
        let st_line =
2168
          Stream.from
2169
            (fun _ ->
2170
               try
2171
                 match Stream.next st with
2172
                   | '\n' -> incr line; Some '\n'
2173
                   | c -> Some c
2174
               with Stream.Failure -> None)
2175
        in
2176
        let lexer =
2177
          Genlex.make_lexer ["="] st_line
2178
        in
2179
        let rec read_file mp =
2180
          match Stream.npeek 3 lexer with
2181
            | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
2182
                Stream.junk lexer;
2183
                Stream.junk lexer;
2184
                Stream.junk lexer;
2185
                read_file (MapString.add nm value mp)
2186
            | [] ->
2187
                mp
2188
            | _ ->
2189
                failwith
2190
                  (Printf.sprintf
2191
                     "Malformed data file '%s' line %d"
2192
                     filename !line)
2193
        in
2194
        let mp =
2195
          read_file MapString.empty
2196
        in
2197
          close_in chn;
2198
          mp
2199
      end
2200
    else if allow_empty then
2201
      begin
2202
        MapString.empty
2203
      end
2204
    else
2205
      begin
2206
        failwith
2207
          (Printf.sprintf
2208
             "Unable to load environment, the file '%s' doesn't exist."
2209
             filename)
2210
      end
2211

    
2212
  let var_get name env =
2213
    let rec var_expand str =
2214
      let buff =
2215
        Buffer.create ((String.length str) * 2)
2216
      in
2217
        Buffer.add_substitute
2218
          buff
2219
          (fun var ->
2220
             try
2221
               var_expand (MapString.find var env)
2222
             with Not_found ->
2223
               failwith
2224
                 (Printf.sprintf
2225
                    "No variable %s defined when trying to expand %S."
2226
                    var
2227
                    str))
2228
          str;
2229
        Buffer.contents buff
2230
    in
2231
      var_expand (MapString.find name env)
2232

    
2233
  let var_choose lst env =
2234
    OASISExpr.choose
2235
      (fun nm -> var_get nm env)
2236
      lst
2237
end
2238

    
2239

    
2240
# 2240 "setup.ml"
2241
module BaseContext = struct
2242
(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseContext.ml" *)
2243

    
2244
  open OASISContext
2245

    
2246
  let args = args
2247

    
2248
  let default = default
2249

    
2250
end
2251

    
2252
module BaseMessage = struct
2253
(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseMessage.ml" *)
2254

    
2255
  (** Message to user, overrid for Base
2256
      @author Sylvain Le Gall
2257
    *)
2258
  open OASISMessage
2259
  open BaseContext
2260

    
2261
  let debug fmt   = debug ~ctxt:!default fmt
2262

    
2263
  let info fmt    = info ~ctxt:!default fmt
2264

    
2265
  let warning fmt = warning ~ctxt:!default fmt
2266

    
2267
  let error fmt = error ~ctxt:!default fmt
2268

    
2269
end
2270

    
2271
module BaseEnv = struct
2272
(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseEnv.ml" *)
2273

    
2274
  open OASISGettext
2275
  open OASISUtils
2276
  open PropList
2277

    
2278
  module MapString = BaseEnvLight.MapString
2279

    
2280
  type origin_t =
2281
    | ODefault
2282
    | OGetEnv
2283
    | OFileLoad
2284
    | OCommandLine
2285

    
2286
  type cli_handle_t =
2287
    | CLINone
2288
    | CLIAuto
2289
    | CLIWith
2290
    | CLIEnable
2291
    | CLIUser of (Arg.key * Arg.spec * Arg.doc) list
2292

    
2293
  type definition_t =
2294
      {
2295
        hide:       bool;
2296
        dump:       bool;
2297
        cli:        cli_handle_t;
2298
        arg_help:   string option;
2299
        group:      string option;
2300
      }
2301

    
2302
  let schema =
2303
    Schema.create "environment"
2304

    
2305
  (* Environment data *)
2306
  let env =
2307
    Data.create ()
2308

    
2309
  (* Environment data from file *)
2310
  let env_from_file =
2311
    ref MapString.empty
2312

    
2313
  (* Lexer for var *)
2314
  let var_lxr =
2315
    Genlex.make_lexer []
2316

    
2317
  let rec var_expand str =
2318
    let buff =
2319
      Buffer.create ((String.length str) * 2)
2320
    in
2321
      Buffer.add_substitute
2322
        buff
2323
        (fun var ->
2324
           try
2325
             (* TODO: this is a quick hack to allow calling Test.Command
2326
              * without defining executable name really. I.e. if there is
2327
              * an exec Executable toto, then $(toto) should be replace
2328
              * by its real name. It is however useful to have this function
2329
              * for other variable that depend on the host and should be
2330
              * written better than that.
2331
              *)
2332
             let st =
2333
               var_lxr (Stream.of_string var)
2334
             in
2335
               match Stream.npeek 3 st with
2336
                 | [Genlex.Ident "utoh"; Genlex.Ident nm] ->
2337
                     OASISHostPath.of_unix (var_get nm)
2338
                 | [Genlex.Ident "utoh"; Genlex.String s] ->
2339
                     OASISHostPath.of_unix s
2340
                 | [Genlex.Ident "ocaml_escaped"; Genlex.Ident nm] ->
2341
                     String.escaped (var_get nm)
2342
                 | [Genlex.Ident "ocaml_escaped"; Genlex.String s] ->
2343
                     String.escaped s
2344
                 | [Genlex.Ident nm] ->
2345
                     var_get nm
2346
                 | _ ->
2347
                     failwithf
2348
                       (f_ "Unknown expression '%s' in variable expansion of %s.")
2349
                       var
2350
                       str
2351
           with
2352
             | Unknown_field (_, _) ->
2353
                 failwithf
2354
                   (f_ "No variable %s defined when trying to expand %S.")
2355
                   var
2356
                   str
2357
             | Stream.Error e ->
2358
                 failwithf
2359
                   (f_ "Syntax error when parsing '%s' when trying to \
2360
                        expand %S: %s")
2361
                   var
2362
                   str
2363
                   e)
2364
        str;
2365
      Buffer.contents buff
2366

    
2367
  and var_get name =
2368
    let vl =
2369
      try
2370
        Schema.get schema env name
2371
      with Unknown_field _ as e ->
2372
        begin
2373
          try
2374
            MapString.find name !env_from_file
2375
          with Not_found ->
2376
            raise e
2377
        end
2378
    in
2379
      var_expand vl
2380

    
2381
  let var_choose ?printer ?name lst =
2382
    OASISExpr.choose
2383
      ?printer
2384
      ?name
2385
      var_get
2386
      lst
2387

    
2388
  let var_protect vl =
2389
    let buff =
2390
      Buffer.create (String.length vl)
2391
    in
2392
      String.iter
2393
        (function
2394
           | '$' -> Buffer.add_string buff "\\$"
2395
           | c   -> Buffer.add_char   buff c)
2396
        vl;
2397
      Buffer.contents buff
2398

    
2399
  let var_define
2400
        ?(hide=false)
2401
        ?(dump=true)
2402
        ?short_desc
2403
        ?(cli=CLINone)
2404
        ?arg_help
2405
        ?group
2406
        name (* TODO: type constraint on the fact that name must be a valid OCaml
2407
                  id *)
2408
        dflt =
2409

    
2410
    let default =
2411
      [
2412
        OFileLoad, (fun () -> MapString.find name !env_from_file);
2413
        ODefault,  dflt;
2414
        OGetEnv,   (fun () -> Sys.getenv name);
2415
      ]
2416
    in
2417

    
2418
    let extra =
2419
      {
2420
        hide     = hide;
2421
        dump     = dump;
2422
        cli      = cli;
2423
        arg_help = arg_help;
2424
        group    = group;
2425
      }
2426
    in
2427

    
2428
    (* Try to find a value that can be defined
2429
     *)
2430
    let var_get_low lst =
2431
      let errors, res =
2432
        List.fold_left
2433
          (fun (errors, res) (o, v) ->
2434
             if res = None then
2435
               begin
2436
                 try
2437
                   errors, Some (v ())
2438
                 with
2439
                   | Not_found ->
2440
                        errors, res
2441
                   | Failure rsn ->
2442
                       (rsn :: errors), res
2443
                   | e ->
2444
                       (Printexc.to_string e) :: errors, res
2445
               end
2446
             else
2447
               errors, res)
2448
          ([], None)
2449
          (List.sort
2450
             (fun (o1, _) (o2, _) ->
2451
                Pervasives.compare o2 o1)
2452
             lst)
2453
      in
2454
        match res, errors with
2455
          | Some v, _ ->
2456
              v
2457
          | None, [] ->
2458
              raise (Not_set (name, None))
2459
          | None, lst ->
2460
              raise (Not_set (name, Some (String.concat (s_ ", ") lst)))
2461
    in
2462

    
2463
    let help =
2464
      match short_desc with
2465
        | Some fs -> Some fs
2466
        | None -> None
2467
    in
2468

    
2469
    let var_get_lst =
2470
      FieldRO.create
2471
        ~schema
2472
        ~name
2473
        ~parse:(fun ?(context=ODefault) s -> [context, fun () -> s])
2474
        ~print:var_get_low
2475
        ~default
2476
        ~update:(fun ?context x old_x -> x @ old_x)
2477
        ?help
2478
        extra
2479
    in
2480

    
2481
      fun () ->
2482
        var_expand (var_get_low (var_get_lst env))
2483

    
2484
  let var_redefine
2485
        ?hide
2486
        ?dump
2487
        ?short_desc
2488
        ?cli
2489
        ?arg_help
2490
        ?group
2491
        name
2492
        dflt =
2493
    if Schema.mem schema name then
2494
      begin
2495
        (* TODO: look suspsicious, we want to memorize dflt not dflt () *)
2496
        Schema.set schema env ~context:ODefault name (dflt ());
2497
        fun () -> var_get name
2498
      end
2499
    else
2500
      begin
2501
        var_define
2502
          ?hide
2503
          ?dump
2504
          ?short_desc
2505
          ?cli
2506
          ?arg_help
2507
          ?group
2508
          name
2509
          dflt
2510
      end
2511

    
2512
  let var_ignore (e : unit -> string) =
2513
    ()
2514

    
2515
  let print_hidden =
2516
    var_define
2517
      ~hide:true
2518
      ~dump:false
2519
      ~cli:CLIAuto
2520
      ~arg_help:"Print even non-printable variable. (debug)"
2521
      "print_hidden"
2522
      (fun () -> "false")
2523

    
2524
  let var_all () =
2525
    List.rev
2526
      (Schema.fold
2527
         (fun acc nm def _ ->
2528
            if not def.hide || bool_of_string (print_hidden ()) then
2529
              nm :: acc
2530
            else
2531
              acc)
2532
         []
2533
         schema)
2534

    
2535
  let default_filename =
2536
    BaseEnvLight.default_filename
2537

    
2538
  let load ?allow_empty ?filename () =
2539
    env_from_file := BaseEnvLight.load ?allow_empty ?filename ()
2540

    
2541
  let unload () =
2542
    env_from_file := MapString.empty;
2543
    Data.clear env
2544

    
2545
  let dump ?(filename=default_filename) () =
2546
    let chn =
2547
      open_out_bin filename
2548
    in
2549
    let output nm value = 
2550
      Printf.fprintf chn "%s=%S\n" nm value
2551
    in
2552
    let mp_todo = 
2553
      (* Dump data from schema *)
2554
      Schema.fold
2555
        (fun mp_todo nm def _ ->
2556
           if def.dump then
2557
             begin
2558
               try
2559
                 let value =
2560
                   Schema.get
2561
                     schema
2562
                     env
2563
                     nm
2564
                 in
2565
                   output nm value
2566
               with Not_set _ ->
2567
                 ()
2568
             end;
2569
           MapString.remove nm mp_todo)
2570
        !env_from_file
2571
        schema
2572
    in
2573
      (* Dump data defined outside of schema *)
2574
      MapString.iter output mp_todo;
2575

    
2576
      (* End of the dump *)
2577
      close_out chn
2578

    
2579
  let print () =
2580
    let printable_vars =
2581
      Schema.fold
2582
        (fun acc nm def short_descr_opt ->
2583
           if not def.hide || bool_of_string (print_hidden ()) then
2584
             begin
2585
               try
2586
                 let value =
2587
                   Schema.get
2588
                     schema
2589
                     env
2590
                     nm
2591
                 in
2592
                 let txt =
2593
                   match short_descr_opt with
2594
                     | Some s -> s ()
2595
                     | None -> nm
2596
                 in
2597
                   (txt, value) :: acc
2598
               with Not_set _ ->
2599
                   acc
2600
             end
2601
           else
2602
             acc)
2603
        []
2604
        schema
2605
    in
2606
    let max_length =
2607
      List.fold_left max 0
2608
        (List.rev_map String.length
2609
           (List.rev_map fst printable_vars))
2610
    in
2611
    let dot_pad str =
2612
      String.make ((max_length - (String.length str)) + 3) '.'
2613
    in
2614

    
2615
    Printf.printf "\nConfiguration: \n";
2616
    List.iter
2617
      (fun (name,value) ->
2618
        Printf.printf "%s: %s %s\n" name (dot_pad name) value)
2619
      (List.rev printable_vars);
2620
    Printf.printf "\n%!"
2621

    
2622
  let args () =
2623
    let arg_concat =
2624
      OASISUtils.varname_concat ~hyphen:'-'
2625
    in
2626
      [
2627
        "--override",
2628
         Arg.Tuple
2629
           (
2630
             let rvr = ref ""
2631
             in
2632
             let rvl = ref ""
2633
             in
2634
               [
2635
                 Arg.Set_string rvr;
2636
                 Arg.Set_string rvl;
2637
                 Arg.Unit
2638
                   (fun () ->
2639
                      Schema.set
2640
                        schema
2641
                        env
2642
                        ~context:OCommandLine
2643
                        !rvr
2644
                        !rvl)
2645
               ]
2646
           ),
2647
        "var+val  Override any configuration variable.";
2648

    
2649
      ]
2650
      @
2651
      List.flatten
2652
        (Schema.fold
2653
          (fun acc name def short_descr_opt ->
2654
             let var_set s =
2655
               Schema.set
2656
                 schema
2657
                 env
2658
                 ~context:OCommandLine
2659
                 name
2660
                 s
2661
             in
2662

    
2663
             let arg_name =
2664
               OASISUtils.varname_of_string ~hyphen:'-' name
2665
             in
2666

    
2667
             let hlp =
2668
               match short_descr_opt with
2669
                 | Some txt -> txt ()
2670
                 | None -> ""
2671
             in
2672

    
2673
             let arg_hlp =
2674
               match def.arg_help with
2675
                 | Some s -> s
2676
                 | None   -> "str"
2677
             in
2678

    
2679
             let default_value =
2680
               try
2681
                 Printf.sprintf
2682
                   (f_ " [%s]")
2683
                   (Schema.get
2684
                      schema
2685
                      env
2686
                      name)
2687
               with Not_set _ ->
2688
                 ""
2689
             in
2690

    
2691
             let args =
2692
               match def.cli with
2693
                 | CLINone ->
2694
                     []
2695
                 | CLIAuto ->
2696
                     [
2697
                       arg_concat "--" arg_name,
2698
                       Arg.String var_set,
2699
                       Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value
2700
                     ]
2701
                 | CLIWith ->
2702
                     [
2703
                       arg_concat "--with-" arg_name,
2704
                       Arg.String var_set,
2705
                       Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value
2706
                     ]
2707
                 | CLIEnable ->
2708
                     let dflt =
2709
                       if default_value = " [true]" then
2710
                         s_ " [default: enabled]"
2711
                       else
2712
                         s_ " [default: disabled]"
2713
                     in
2714
                       [
2715
                         arg_concat "--enable-" arg_name,
2716
                         Arg.Unit (fun () -> var_set "true"),
2717
                         Printf.sprintf (f_ " %s%s") hlp dflt;
2718

    
2719
                         arg_concat "--disable-" arg_name,
2720
                         Arg.Unit (fun () -> var_set "false"),
2721
                         Printf.sprintf (f_ " %s%s") hlp dflt
2722
                       ]
2723
                 | CLIUser lst ->
2724
                     lst
2725
             in
2726
               args :: acc)
2727
           []
2728
           schema)
2729
end
2730

    
2731
module BaseArgExt = struct
2732
(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseArgExt.ml" *)
2733

    
2734
  open OASISUtils
2735
  open OASISGettext
2736

    
2737
  let parse argv args =
2738
      (* Simulate command line for Arg *)
2739
      let current =
2740
        ref 0
2741
      in
2742

    
2743
        try
2744
          Arg.parse_argv
2745
            ~current:current
2746
            (Array.concat [[|"none"|]; argv])
2747
            (Arg.align args)
2748
            (failwithf (f_ "Don't know what to do with arguments: '%s'"))
2749
            (s_ "configure options:")
2750
        with
2751
          | Arg.Help txt ->
2752
              print_endline txt;
2753
              exit 0
2754
          | Arg.Bad txt ->
2755
              prerr_endline txt;
2756
              exit 1
2757
end
2758

    
2759
module BaseCheck = struct
2760
(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseCheck.ml" *)
2761

    
2762
  open BaseEnv
2763
  open BaseMessage
2764
  open OASISUtils
2765
  open OASISGettext
2766

    
2767
  let prog_best prg prg_lst =
2768
    var_redefine
2769
      prg
2770
      (fun () ->
2771
         let alternate =
2772
           List.fold_left
2773
             (fun res e ->
2774
                match res with
2775
                  | Some _ ->
2776
                      res
2777
                  | None ->
2778
                      try
2779
                        Some (OASISFileUtil.which ~ctxt:!BaseContext.default e)
2780
                      with Not_found ->
2781
                        None)
2782
             None
2783
             prg_lst
2784
         in
2785
           match alternate with
2786
             | Some prg -> prg
2787
             | None -> raise Not_found)
2788

    
2789
  let prog prg =
2790
    prog_best prg [prg]
2791

    
2792
  let prog_opt prg =
2793
    prog_best prg [prg^".opt"; prg]
2794

    
2795
  let ocamlfind =
2796
    prog "ocamlfind"
2797

    
2798
  let version
2799
        var_prefix
2800
        cmp
2801
        fversion
2802
        () =
2803
    (* Really compare version provided *)
2804
    let var =
2805
      var_prefix^"_version_"^(OASISVersion.varname_of_comparator cmp)
2806
    in
2807
      var_redefine
2808
        ~hide:true
2809
        var
2810
        (fun () ->
2811
           let version_str =
2812
             match fversion () with
2813
               | "[Distributed with OCaml]" ->
2814
                   begin
2815
                     try
2816
                       (var_get "ocaml_version")
2817
                     with Not_found ->
2818
                       warning
2819
                         (f_ "Variable ocaml_version not defined, fallback \
2820
                              to default");
2821
                       Sys.ocaml_version
2822
                   end
2823
               | res ->
2824
                   res
2825
           in
2826
           let version =
2827
             OASISVersion.version_of_string version_str
2828
           in
2829
             if OASISVersion.comparator_apply version cmp then
2830
               version_str
2831
             else
2832
               failwithf
2833
                 (f_ "Cannot satisfy version constraint on %s: %s (version: %s)")
2834
                 var_prefix
2835
                 (OASISVersion.string_of_comparator cmp)
2836
                 version_str)
2837
        ()
2838

    
2839
  let package_version pkg =
2840
    OASISExec.run_read_one_line ~ctxt:!BaseContext.default
2841
      (ocamlfind ())
2842
      ["query"; "-format"; "%v"; pkg]
2843

    
2844
  let package ?version_comparator pkg () =
2845
    let var =
2846
      OASISUtils.varname_concat
2847
        "pkg_"
2848
        (OASISUtils.varname_of_string pkg)
2849
    in
2850
    let findlib_dir pkg =
2851
      let dir =
2852
        OASISExec.run_read_one_line ~ctxt:!BaseContext.default
2853
          (ocamlfind ())
2854
          ["query"; "-format"; "%d"; pkg]
2855
      in
2856
        if Sys.file_exists dir && Sys.is_directory dir then
2857
          dir
2858
        else
2859
          failwithf
2860
            (f_ "When looking for findlib package %s, \
2861
                 directory %s return doesn't exist")
2862
            pkg dir
2863
    in
2864
    let vl =
2865
      var_redefine
2866
        var
2867
        (fun () -> findlib_dir pkg)
2868
        ()
2869
    in
2870
      (
2871
        match version_comparator with
2872
          | Some ver_cmp ->
2873
              ignore
2874
                (version
2875
                   var
2876
                   ver_cmp
2877
                   (fun _ -> package_version pkg)
2878
                   ())
2879
          | None ->
2880
              ()
2881
      );
2882
      vl
2883
end
2884

    
2885
module BaseOCamlcConfig = struct
2886
(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseOCamlcConfig.ml" *)
2887

    
2888

    
2889
  open BaseEnv
2890
  open OASISUtils
2891
  open OASISGettext
2892

    
2893
  module SMap = Map.Make(String)
2894

    
2895
  let ocamlc =
2896
    BaseCheck.prog_opt "ocamlc"
2897

    
2898
  let ocamlc_config_map =
2899
    (* Map name to value for ocamlc -config output
2900
       (name ^": "^value)
2901
     *)
2902
    let rec split_field mp lst =
2903
      match lst with
2904
        | line :: tl ->
2905
            let mp =
2906
              try
2907
                let pos_semicolon =
2908
                  String.index line ':'
2909
                in
2910
                  if pos_semicolon > 1 then
2911
                    (
2912
                      let name =
2913
                        String.sub line 0 pos_semicolon
2914
                      in
2915
                      let linelen =
2916
                        String.length line
2917
                      in
2918
                      let value =
2919
                        if linelen > pos_semicolon + 2 then
2920
                          String.sub
2921
                            line
2922
                            (pos_semicolon + 2)
2923
                            (linelen - pos_semicolon - 2)
2924
                        else
2925
                          ""
2926
                      in
2927
                        SMap.add name value mp
2928
                    )
2929
                  else
2930
                    (
2931
                      mp
2932
                    )
2933
              with Not_found ->
2934
                (
2935
                  mp
2936
                )
2937
            in
2938
              split_field mp tl
2939
        | [] ->
2940
            mp
2941
    in
2942

    
2943
    let cache = 
2944
      lazy
2945
        (var_protect
2946
           (Marshal.to_string
2947
              (split_field
2948
                 SMap.empty
2949
                 (OASISExec.run_read_output
2950
                    ~ctxt:!BaseContext.default
2951
                    (ocamlc ()) ["-config"]))
2952
              []))
2953
    in
2954
      var_redefine
2955
        "ocamlc_config_map"
2956
        ~hide:true
2957
        ~dump:false
2958
        (fun () ->
2959
           (* TODO: update if ocamlc change !!! *)
2960
           Lazy.force cache)
2961

    
2962
  let var_define nm =
2963
    (* Extract data from ocamlc -config *)
2964
    let avlbl_config_get () =
2965
      Marshal.from_string
2966
        (ocamlc_config_map ())
2967
        0
2968
    in
2969
    let chop_version_suffix s =
2970
      try 
2971
        String.sub s 0 (String.index s '+')
2972
      with _ -> 
2973
        s
2974
     in
2975

    
2976
    let nm_config, value_config =
2977
      match nm with
2978
        | "ocaml_version" -> 
2979
            "version", chop_version_suffix
2980
        | _ -> nm, (fun x -> x)
2981
    in
2982
      var_redefine
2983
        nm
2984
        (fun () ->
2985
          try
2986
             let map =
2987
               avlbl_config_get ()
2988
             in
2989
             let value =
2990
               SMap.find nm_config map
2991
             in
2992
               value_config value
2993
           with Not_found ->
2994
             failwithf
2995
               (f_ "Cannot find field '%s' in '%s -config' output")
2996
               nm
2997
               (ocamlc ()))
2998

    
2999
end
3000

    
3001
module BaseStandardVar = struct
3002
(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseStandardVar.ml" *)
3003

    
3004

    
3005
  open OASISGettext
3006
  open OASISTypes
3007
  open OASISExpr
3008
  open BaseCheck
3009
  open BaseEnv
3010

    
3011
  let ocamlfind  = BaseCheck.ocamlfind
3012
  let ocamlc     = BaseOCamlcConfig.ocamlc
3013
  let ocamlopt   = prog_opt "ocamlopt"
3014
  let ocamlbuild = prog "ocamlbuild"
3015

    
3016

    
3017
  (**/**)
3018
  let rpkg =
3019
    ref None
3020

    
3021
  let pkg_get () =
3022
    match !rpkg with
3023
      | Some pkg -> pkg
3024
      | None -> failwith (s_ "OASIS Package is not set")
3025

    
3026
  let var_cond = ref []
3027

    
3028
  let var_define_cond ~since_version f dflt =
3029
    let holder = ref (fun () -> dflt) in
3030
    let since_version =
3031
      OASISVersion.VGreaterEqual (OASISVersion.version_of_string since_version)
3032
    in
3033
      var_cond :=
3034
      (fun ver ->
3035
         if OASISVersion.comparator_apply ver since_version then
3036
           holder := f ()) :: !var_cond;
3037
      fun () -> !holder ()
3038

    
3039
  (**/**)
3040

    
3041
  let pkg_name =
3042
    var_define
3043
      ~short_desc:(fun () -> s_ "Package name")
3044
      "pkg_name"
3045
      (fun () -> (pkg_get ()).name)
3046

    
3047
  let pkg_version =
3048
    var_define
3049
      ~short_desc:(fun () -> s_ "Package version")
3050
      "pkg_version"
3051
      (fun () ->
3052
         (OASISVersion.string_of_version (pkg_get ()).version))
3053

    
3054
  let c = BaseOCamlcConfig.var_define
3055

    
3056
  let os_type        = c "os_type"
3057
  let system         = c "system"
3058
  let architecture   = c "architecture"
3059
  let ccomp_type     = c "ccomp_type"
3060
  let ocaml_version  = c "ocaml_version"
3061

    
3062
  (* TODO: Check standard variable presence at runtime *)
3063

    
3064
  let standard_library_default = c "standard_library_default"
3065
  let standard_library         = c "standard_library"
3066
  let standard_runtime         = c "standard_runtime"
3067
  let bytecomp_c_compiler      = c "bytecomp_c_compiler"
3068
  let native_c_compiler        = c "native_c_compiler"
3069
  let model                    = c "model"
3070
  let ext_obj                  = c "ext_obj"
3071
  let ext_asm                  = c "ext_asm"
3072
  let ext_lib                  = c "ext_lib"
3073
  let ext_dll                  = c "ext_dll"
3074
  let default_executable_name  = c "default_executable_name"
3075
  let systhread_supported      = c "systhread_supported"
3076

    
3077
  let flexlink = 
3078
    BaseCheck.prog "flexlink"
3079

    
3080
  let flexdll_version =
3081
    var_define
3082
      ~short_desc:(fun () -> "FlexDLL version (Win32)")
3083
      "flexdll_version"
3084
      (fun () ->
3085
         let lst = 
3086
           OASISExec.run_read_output ~ctxt:!BaseContext.default
3087
             (flexlink ()) ["-help"]
3088
         in
3089
           match lst with 
3090
             | line :: _ ->
3091
                 Scanf.sscanf line "FlexDLL version %s" (fun ver -> ver)
3092
             | [] ->
3093
                 raise Not_found)
3094

    
3095
  (**/**)
3096
  let p name hlp dflt =
3097
    var_define
3098
      ~short_desc:hlp
3099
      ~cli:CLIAuto
3100
      ~arg_help:"dir"
3101
      name
3102
      dflt
3103

    
3104
  let (/) a b =
3105
    if os_type () = Sys.os_type then
3106
      Filename.concat a b
3107
    else if os_type () = "Unix" then
3108
      OASISUnixPath.concat a b
3109
    else
3110
      OASISUtils.failwithf (f_ "Cannot handle os_type %s filename concat")
3111
        (os_type ())
3112
  (**/**)
3113

    
3114
  let prefix =
3115
    p "prefix"
3116
      (fun () -> s_ "Install architecture-independent files dir")
3117
      (fun () ->
3118
         match os_type () with
3119
           | "Win32" ->
3120
               let program_files =
3121
                 Sys.getenv "PROGRAMFILES"
3122
               in
3123
                 program_files/(pkg_name ())
3124
           | _ ->
3125
               "/usr/local")
3126

    
3127
  let exec_prefix =
3128
    p "exec_prefix"
3129
      (fun () -> s_ "Install architecture-dependent files in dir")
3130
      (fun () -> "$prefix")
3131

    
3132
  let bindir =
3133
    p "bindir"
3134
      (fun () -> s_ "User executables")
3135
      (fun () -> "$exec_prefix"/"bin")
3136

    
3137
  let sbindir =
3138
    p "sbindir"
3139
      (fun () -> s_ "System admin executables")
3140
      (fun () -> "$exec_prefix"/"sbin")
3141

    
3142
  let libexecdir =
3143
    p "libexecdir"
3144
      (fun () -> s_ "Program executables")
3145
      (fun () -> "$exec_prefix"/"libexec")
3146

    
3147
  let sysconfdir =
3148
    p "sysconfdir"
3149
      (fun () -> s_ "Read-only single-machine data")
3150
      (fun () -> "$prefix"/"etc")
3151

    
3152
  let sharedstatedir =
3153
    p "sharedstatedir"
3154
      (fun () -> s_ "Modifiable architecture-independent data")
3155
      (fun () -> "$prefix"/"com")
3156

    
3157
  let localstatedir =
3158
    p "localstatedir"
3159
      (fun () -> s_ "Modifiable single-machine data")
3160
      (fun () -> "$prefix"/"var")
3161

    
3162
  let libdir =
3163
    p "libdir"
3164
      (fun () -> s_ "Object code libraries")
3165
      (fun () -> "$exec_prefix"/"lib")
3166

    
3167
  let datarootdir =
3168
    p "datarootdir"
3169
      (fun () -> s_ "Read-only arch-independent data root")
3170
      (fun () -> "$prefix"/"share")
3171

    
3172
  let datadir =
3173
    p "datadir"
3174
      (fun () -> s_ "Read-only architecture-independent data")
3175
      (fun () -> "$datarootdir")
3176

    
3177
  let infodir =
3178
    p "infodir"
3179
      (fun () -> s_ "Info documentation")
3180
      (fun () -> "$datarootdir"/"info")
3181

    
3182
  let localedir =
3183
    p "localedir"
3184
      (fun () -> s_ "Locale-dependent data")
3185
      (fun () -> "$datarootdir"/"locale")
3186

    
3187
  let mandir =
3188
    p "mandir"
3189
      (fun () -> s_ "Man documentation")
3190
      (fun () -> "$datarootdir"/"man")
3191

    
3192
  let docdir =
3193
    p "docdir"
3194
      (fun () -> s_ "Documentation root")
3195
      (fun () -> "$datarootdir"/"doc"/"$pkg_name")
3196

    
3197
  let htmldir =
3198
    p "htmldir"
3199
      (fun () -> s_ "HTML documentation")
3200
      (fun () -> "$docdir")
3201

    
3202
  let dvidir =
3203
    p "dvidir"
3204
      (fun () -> s_ "DVI documentation")
3205
      (fun () -> "$docdir")
3206

    
3207
  let pdfdir =
3208
    p "pdfdir"
3209
      (fun () -> s_ "PDF documentation")
3210
      (fun () -> "$docdir")
3211

    
3212
  let psdir =
3213
    p "psdir"
3214
      (fun () -> s_ "PS documentation")
3215
      (fun () -> "$docdir")
3216

    
3217
  let destdir =
3218
    p "destdir"
3219
      (fun () -> s_ "Prepend a path when installing package")
3220
      (fun () ->
3221
         raise
3222
           (PropList.Not_set
3223
              ("destdir",
3224
               Some (s_ "undefined by construct"))))
3225

    
3226
  let findlib_version =
3227
    var_define
3228
      "findlib_version"
3229
      (fun () ->
3230
         BaseCheck.package_version "findlib")
3231

    
3232
  let is_native =
3233
    var_define
3234
      "is_native"
3235
      (fun () ->
3236
         try
3237
           let _s : string =
3238
             ocamlopt ()
3239
           in
3240
             "true"
3241
         with PropList.Not_set _ ->
3242
           let _s : string =
3243
             ocamlc ()
3244
           in
3245
             "false")
3246

    
3247
  let ext_program =
3248
    var_define
3249
      "suffix_program"
3250
      (fun () ->
3251
         match os_type () with
3252
           | "Win32" -> ".exe"
3253
           | _ -> "")
3254

    
3255
  let rm =
3256
    var_define
3257
      ~short_desc:(fun () -> s_ "Remove a file.")
3258
      "rm"
3259
      (fun () ->
3260
         match os_type () with
3261
           | "Win32" -> "del"
3262
           | _ -> "rm -f")
3263

    
3264
  let rmdir =
3265
    var_define
3266
      ~short_desc:(fun () -> s_ "Remove a directory.")
3267
      "rmdir"
3268
      (fun () ->
3269
         match os_type () with
3270
           | "Win32" -> "rd"
3271
           | _ -> "rm -rf")
3272

    
3273
  let debug =
3274
    var_define
3275
      ~short_desc:(fun () -> s_ "Turn ocaml debug flag on")
3276
      ~cli:CLIEnable
3277
      "debug"
3278
      (fun () -> "true")
3279

    
3280
  let profile =
3281
    var_define
3282
      ~short_desc:(fun () -> s_ "Turn ocaml profile flag on")
3283
      ~cli:CLIEnable
3284
      "profile"
3285
      (fun () -> "false")
3286

    
3287
  let tests =
3288
    var_define_cond ~since_version:"0.3"
3289
      (fun () ->
3290
         var_define
3291
           ~short_desc:(fun () ->
3292
                          s_ "Compile tests executable and library and run them")
3293
           ~cli:CLIEnable
3294
           "tests"
3295
           (fun () -> "false"))
3296
      "true"
3297

    
3298
  let docs =
3299
    var_define_cond ~since_version:"0.3"
3300
      (fun () ->
3301
         var_define
3302
           ~short_desc:(fun () -> s_ "Create documentations")
3303
           ~cli:CLIEnable
3304
           "docs"
3305
           (fun () -> "true"))
3306
      "true"
3307

    
3308
  let native_dynlink =
3309
    var_define
3310
      ~short_desc:(fun () -> s_ "Compiler support generation of .cmxs.")
3311
      ~cli:CLINone
3312
      "native_dynlink"
3313
      (fun () ->
3314
         let res =
3315
           let ocaml_lt_312 () = 
3316
             OASISVersion.comparator_apply
3317
               (OASISVersion.version_of_string (ocaml_version ()))
3318
               (OASISVersion.VLesser
3319
                  (OASISVersion.version_of_string "3.12.0"))
3320
           in
3321
           let flexdll_lt_030 () =
3322
             OASISVersion.comparator_apply
3323
               (OASISVersion.version_of_string (flexdll_version ()))
3324
               (OASISVersion.VLesser
3325
                  (OASISVersion.version_of_string "0.30"))
3326
           in
3327
           let has_native_dynlink = 
3328
             let ocamlfind = ocamlfind () in
3329
               try
3330
                 let fn =
3331
                   OASISExec.run_read_one_line
3332
                     ~ctxt:!BaseContext.default
3333
                     ocamlfind
3334
                     ["query"; "-predicates"; "native"; "dynlink";
3335
                      "-format"; "%d/%a"]
3336
                 in
3337
                   Sys.file_exists fn
3338
               with _ ->
3339
                 false
3340
           in
3341
             if not has_native_dynlink then
3342
               false
3343
             else if ocaml_lt_312 () then
3344
               false
3345
             else if (os_type () = "Win32" || os_type () = "Cygwin") 
3346
                     && flexdll_lt_030 () then
3347
               begin
3348
                 BaseMessage.warning 
3349
                   (f_ ".cmxs generation disabled because FlexDLL needs to be \
3350
                        at least 0.30. Please upgrade FlexDLL from %s to 0.30.")
3351
                   (flexdll_version ());
3352
                 false
3353
               end
3354
             else
3355
               true
3356
         in
3357
           string_of_bool res)
3358

    
3359
  let init pkg =
3360
    rpkg := Some pkg;
3361
    List.iter (fun f -> f pkg.oasis_version) !var_cond
3362

    
3363
end
3364

    
3365
module BaseFileAB = struct
3366
(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseFileAB.ml" *)
3367

    
3368
  open BaseEnv
3369
  open OASISGettext
3370
  open BaseMessage
3371

    
3372
  let to_filename fn =
3373
    let fn =
3374
      OASISHostPath.of_unix fn
3375
    in
3376
      if not (Filename.check_suffix fn ".ab") then
3377
        warning
3378
          (f_ "File '%s' doesn't have '.ab' extension")
3379
          fn;
3380
      Filename.chop_extension fn
3381

    
3382
  let replace fn_lst =
3383
    let buff =
3384
      Buffer.create 13
3385
    in
3386
      List.iter
3387
        (fun fn ->
3388
           let fn =
3389
             OASISHostPath.of_unix fn
3390
           in
3391
           let chn_in =
3392
             open_in fn
3393
           in
3394
           let chn_out =
3395
             open_out (to_filename fn)
3396
           in
3397
             (
3398
               try
3399
                 while true do
3400
                  Buffer.add_string buff (var_expand (input_line chn_in));
3401
                  Buffer.add_char buff '\n'
3402
                 done
3403
               with End_of_file ->
3404
                 ()
3405
             );
3406
             Buffer.output_buffer chn_out buff;
3407
             Buffer.clear buff;
3408
             close_in chn_in;
3409
             close_out chn_out)
3410
        fn_lst
3411
end
3412

    
3413
module BaseLog = struct
3414
(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseLog.ml" *)
3415

    
3416
  open OASISUtils
3417

    
3418
  let default_filename =
3419
    Filename.concat
3420
      (Filename.dirname BaseEnv.default_filename)
3421
      "setup.log"
3422

    
3423
  module SetTupleString =
3424
    Set.Make
3425
      (struct
3426
         type t = string * string
3427
         let compare (s11, s12) (s21, s22) =
3428
           match String.compare s11 s21 with
3429
             | 0 -> String.compare s12 s22
3430
             | n -> n
3431
       end)
3432

    
3433
  let load () =
3434
    if Sys.file_exists default_filename then
3435
      begin
3436
        let chn =
3437
          open_in default_filename
3438
        in
3439
        let scbuf =
3440
          Scanf.Scanning.from_file default_filename
3441
        in
3442
        let rec read_aux (st, lst) =
3443
          if not (Scanf.Scanning.end_of_input scbuf) then
3444
            begin
3445
              let acc =
3446
                try
3447
                  Scanf.bscanf scbuf "%S %S\n"
3448
                    (fun e d ->
3449
                       let t =
3450
                         e, d
3451
                       in
3452
                         if SetTupleString.mem t st then
3453
                           st, lst
3454
                         else
3455
                           SetTupleString.add t st,
3456
                           t :: lst)
3457
                with Scanf.Scan_failure _ ->
3458
                  failwith
3459
                    (Scanf.bscanf scbuf
3460
                       "%l"
3461
                       (fun line ->
3462
                          Printf.sprintf
3463
                            "Malformed log file '%s' at line %d"
3464
                            default_filename
3465
                            line))
3466
              in
3467
                read_aux acc
3468
            end
3469
          else
3470
            begin
3471
              close_in chn;
3472
              List.rev lst
3473
            end
3474
        in
3475
          read_aux (SetTupleString.empty, [])
3476
      end
3477
    else
3478
      begin
3479
        []
3480
      end
3481

    
3482
  let register event data =
3483
    let chn_out =
3484
      open_out_gen [Open_append; Open_creat; Open_text] 0o644 default_filename
3485
    in
3486
      Printf.fprintf chn_out "%S %S\n" event data;
3487
      close_out chn_out
3488

    
3489
  let unregister event data =
3490
    if Sys.file_exists default_filename then
3491
      begin
3492
        let lst =
3493
          load ()
3494
        in
3495
        let chn_out =
3496
          open_out default_filename
3497
        in
3498
        let write_something =
3499
          ref false
3500
        in
3501
          List.iter
3502
            (fun (e, d) ->
3503
               if e <> event || d <> data then
3504
                 begin
3505
                   write_something := true;
3506
                   Printf.fprintf chn_out "%S %S\n" e d
3507
                 end)
3508
            lst;
3509
          close_out chn_out;
3510
          if not !write_something then
3511
            Sys.remove default_filename
3512
      end
3513

    
3514
  let filter events =
3515
    let st_events =
3516
      List.fold_left
3517
        (fun st e ->
3518
           SetString.add e st)
3519
        SetString.empty
3520
        events
3521
    in
3522
      List.filter
3523
        (fun (e, _) -> SetString.mem e st_events)
3524
        (load ())
3525

    
3526
  let exists event data =
3527
    List.exists
3528
      (fun v -> (event, data) = v)
3529
      (load ())
3530
end
3531

    
3532
module BaseBuilt = struct
3533
(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseBuilt.ml" *)
3534

    
3535
  open OASISTypes
3536
  open OASISGettext
3537
  open BaseStandardVar
3538
  open BaseMessage
3539

    
3540
  type t =
3541
    | BExec    (* Executable *)
3542
    | BExecLib (* Library coming with executable *)
3543
    | BLib     (* Library *)
3544
    | BDoc     (* Document *)
3545

    
3546
  let to_log_event_file t nm =
3547
    "built_"^
3548
    (match t with
3549
       | BExec -> "exec"
3550
       | BExecLib -> "exec_lib"
3551
       | BLib -> "lib"
3552
       | BDoc -> "doc")^
3553
    "_"^nm
3554

    
3555
  let to_log_event_done t nm =
3556
    "is_"^(to_log_event_file t nm)
3557

    
3558
  let register t nm lst =
3559
    BaseLog.register
3560
      (to_log_event_done t nm)
3561
      "true";
3562
    List.iter
3563
      (fun alt ->
3564
         let registered =
3565
           List.fold_left
3566
             (fun registered fn ->
3567
                if OASISFileUtil.file_exists_case fn then
3568
                  begin
3569
                    BaseLog.register
3570
                      (to_log_event_file t nm)
3571
                      (if Filename.is_relative fn then
3572
                         Filename.concat (Sys.getcwd ()) fn
3573
                       else
3574
                         fn);
3575
                    true
3576
                  end
3577
                else
3578
                  registered)
3579
             false
3580
             alt
3581
         in
3582
           if not registered then
3583
             warning
3584
               (f_ "Cannot find an existing alternative files among: %s")
3585
               (String.concat (s_ ", ") alt))
3586
      lst
3587

    
3588
  let unregister t nm =
3589
    List.iter
3590
      (fun (e, d) ->
3591
         BaseLog.unregister e d)
3592
      (BaseLog.filter
3593
         [to_log_event_file t nm;
3594
          to_log_event_done t nm])
3595

    
3596
  let fold t nm f acc =
3597
    List.fold_left
3598
      (fun acc (_, fn) ->
3599
         if OASISFileUtil.file_exists_case fn then
3600
           begin
3601
             f acc fn
3602
           end
3603
         else
3604
           begin
3605
             warning
3606
               (f_ "File '%s' has been marked as built \
3607
                  for %s but doesn't exist")
3608
               fn
3609
               (Printf.sprintf
3610
                  (match t with
3611
                     | BExec | BExecLib ->
3612
                         (f_ "executable %s")
3613
                     | BLib ->
3614
                         (f_ "library %s")
3615
                     | BDoc ->
3616
                         (f_ "documentation %s"))
3617
                  nm);
3618
             acc
3619
           end)
3620
      acc
3621
      (BaseLog.filter
3622
         [to_log_event_file t nm])
3623

    
3624
  let is_built t nm =
3625
    List.fold_left
3626
      (fun is_built (_, d) ->
3627
         (try
3628
            bool_of_string d
3629
          with _ ->
3630
            false))
3631
      false
3632
      (BaseLog.filter
3633
         [to_log_event_done t nm])
3634

    
3635
  let of_executable ffn (cs, bs, exec) =
3636
    let unix_exec_is, unix_dll_opt =
3637
      OASISExecutable.unix_exec_is
3638
        (cs, bs, exec)
3639
        (fun () ->
3640
           bool_of_string
3641
             (is_native ()))
3642
        ext_dll
3643
        ext_program
3644
    in
3645
    let evs =
3646
      (BExec, cs.cs_name, [[ffn unix_exec_is]])
3647
      ::
3648
      (match unix_dll_opt with
3649
         | Some fn ->
3650
             [BExecLib, cs.cs_name, [[ffn fn]]]
3651
         | None ->
3652
             [])
3653
    in
3654
      evs,
3655
      unix_exec_is,
3656
      unix_dll_opt
3657

    
3658
  let of_library ffn (cs, bs, lib) =
3659
    let unix_lst =
3660
      OASISLibrary.generated_unix_files
3661
        ~ctxt:!BaseContext.default
3662
        ~source_file_exists:(fun fn ->
3663
           OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn))
3664
        ~is_native:(bool_of_string (is_native ()))
3665
        ~has_native_dynlink:(bool_of_string (native_dynlink ()))
3666
        ~ext_lib:(ext_lib ())
3667
        ~ext_dll:(ext_dll ())
3668
        (cs, bs, lib)
3669
    in
3670
    let evs =
3671
      [BLib,
3672
       cs.cs_name,
3673
       List.map (List.map ffn) unix_lst]
3674
    in
3675
      evs, unix_lst
3676

    
3677
end
3678

    
3679
module BaseCustom = struct
3680
(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseCustom.ml" *)
3681

    
3682
  open BaseEnv
3683
  open BaseMessage
3684
  open OASISTypes
3685
  open OASISGettext
3686

    
3687
  let run cmd args extra_args =
3688
    OASISExec.run ~ctxt:!BaseContext.default ~quote:false
3689
      (var_expand cmd)
3690
      (List.map
3691
         var_expand
3692
         (args @ (Array.to_list extra_args)))
3693

    
3694
  let hook ?(failsafe=false) cstm f e =
3695
    let optional_command lst =
3696
      let printer =
3697
        function
3698
          | Some (cmd, args) -> String.concat " " (cmd :: args)
3699
          | None -> s_ "No command"
3700
      in
3701
        match
3702
          var_choose
3703
            ~name:(s_ "Pre/Post Command")
3704
            ~printer
3705
            lst with
3706
          | Some (cmd, args) ->
3707
              begin
3708
                try
3709
                  run cmd args [||]
3710
                with e when failsafe ->
3711
                  warning
3712
                    (f_ "Command '%s' fail with error: %s")
3713
                    (String.concat " " (cmd :: args))
3714
                    (match e with
3715
                       | Failure msg -> msg
3716
                       | e -> Printexc.to_string e)
3717
              end
3718
          | None ->
3719
              ()
3720
    in
3721
    let res =
3722
      optional_command cstm.pre_command;
3723
      f e
3724
    in
3725
      optional_command cstm.post_command;
3726
      res
3727
end
3728

    
3729
module BaseDynVar = struct
3730
(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseDynVar.ml" *)
3731

    
3732

    
3733
  open OASISTypes
3734
  open OASISGettext
3735
  open BaseEnv
3736
  open BaseBuilt
3737

    
3738
  let init pkg =
3739
    (* TODO: disambiguate exec vs other variable by adding exec_VARNAME. *)
3740
    (* TODO: provide compile option for library libary_byte_args_VARNAME... *)
3741
    List.iter
3742
      (function
3743
         | Executable (cs, bs, exec) ->
3744
             if var_choose bs.bs_build then
3745
               var_ignore
3746
                 (var_redefine
3747
                    (* We don't save this variable *)
3748
                    ~dump:false
3749
                    ~short_desc:(fun () ->
3750
                                   Printf.sprintf
3751
                                     (f_ "Filename of executable '%s'")
3752
                                     cs.cs_name)
3753
                    (OASISUtils.varname_of_string cs.cs_name)
3754
                    (fun () ->
3755
                       let fn_opt =
3756
                         fold
3757
                           BExec cs.cs_name
3758
                           (fun _ fn -> Some fn)
3759
                           None
3760
                       in
3761
                         match fn_opt with
3762
                           | Some fn -> fn
3763
                           | None ->
3764
                               raise
3765
                                 (PropList.Not_set
3766
                                    (cs.cs_name,
3767
                                     Some (Printf.sprintf
3768
                                             (f_ "Executable '%s' not yet built.")
3769
                                             cs.cs_name)))))
3770

    
3771
         | Library _ | Flag _ | Test _ | SrcRepo _ | Doc _ ->
3772
             ())
3773
      pkg.sections
3774
end
3775

    
3776
module BaseTest = struct
3777
(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseTest.ml" *)
3778

    
3779
  open BaseEnv
3780
  open BaseMessage
3781
  open OASISTypes
3782
  open OASISExpr
3783
  open OASISGettext
3784

    
3785
  let test lst pkg extra_args =
3786

    
3787
    let one_test (failure, n) (test_plugin, cs, test) =
3788
      if var_choose
3789
           ~name:(Printf.sprintf
3790
                    (f_ "test %s run")
3791
                    cs.cs_name)
3792
           ~printer:string_of_bool
3793
           test.test_run then
3794
        begin
3795
          let () =
3796
            info (f_ "Running test '%s'") cs.cs_name
3797
          in
3798
          let back_cwd =
3799
            match test.test_working_directory with
3800
              | Some dir ->
3801
                  let cwd =
3802
                    Sys.getcwd ()
3803
                  in
3804
                  let chdir d =
3805
                    info (f_ "Changing directory to '%s'") d;
3806
                    Sys.chdir d
3807
                  in
3808
                    chdir dir;
3809
                    fun () -> chdir cwd
3810

    
3811
              | None ->
3812
                  fun () -> ()
3813
          in
3814
            try
3815
              let failure_percent =
3816
                BaseCustom.hook
3817
                  test.test_custom
3818
                  (test_plugin pkg (cs, test))
3819
                  extra_args
3820
              in
3821
                back_cwd ();
3822
                (failure_percent +. failure, n + 1)
3823
            with e ->
3824
              begin
3825
                back_cwd ();
3826
                raise e
3827
              end
3828
        end
3829
      else
3830
        begin
3831
          info (f_ "Skipping test '%s'") cs.cs_name;
3832
          (failure, n)
3833
        end
3834
    in
3835
    let (failed, n) =
3836
      List.fold_left
3837
        one_test
3838
        (0.0, 0)
3839
        lst
3840
    in
3841
    let failure_percent =
3842
      if n = 0 then
3843
        0.0
3844
      else
3845
        failed /. (float_of_int n)
3846
    in
3847
    let msg =
3848
      Printf.sprintf
3849
        (f_ "Tests had a %.2f%% failure rate")
3850
        (100. *. failure_percent)
3851
    in
3852
      if failure_percent > 0.0 then
3853
        failwith msg
3854
      else
3855
        info "%s" msg;
3856

    
3857
      (* Possible explanation why the tests where not run. *)
3858
      if OASISVersion.version_0_3_or_after pkg.oasis_version &&
3859
         not (bool_of_string (BaseStandardVar.tests ())) &&
3860
         lst <> [] then
3861
        BaseMessage.warning
3862
          "Tests are turned off, consider enabling with \
3863
           'ocaml setup.ml -configure --enable-tests'"
3864
end
3865

    
3866
module BaseDoc = struct
3867
(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseDoc.ml" *)
3868

    
3869
  open BaseEnv
3870
  open BaseMessage
3871
  open OASISTypes
3872
  open OASISGettext
3873

    
3874
  let doc lst pkg extra_args =
3875

    
3876
    let one_doc (doc_plugin, cs, doc) =
3877
      if var_choose
3878
           ~name:(Printf.sprintf
3879
                   (f_ "documentation %s build")
3880
                   cs.cs_name)
3881
           ~printer:string_of_bool
3882
           doc.doc_build then
3883
        begin
3884
          info (f_ "Building documentation '%s'") cs.cs_name;
3885
          BaseCustom.hook
3886
            doc.doc_custom
3887
            (doc_plugin pkg (cs, doc))
3888
            extra_args
3889
        end
3890
    in
3891
      List.iter one_doc lst;
3892

    
3893
      if OASISVersion.version_0_3_or_after pkg.oasis_version &&
3894
         not (bool_of_string (BaseStandardVar.docs ())) &&
3895
         lst <> [] then
3896
        BaseMessage.warning
3897
          "Docs are turned off, consider enabling with \
3898
           'ocaml setup.ml -configure --enable-docs'"
3899
end
3900

    
3901
module BaseSetup = struct
3902
(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseSetup.ml" *)
3903

    
3904
  open BaseEnv
3905
  open BaseMessage
3906
  open OASISTypes
3907
  open OASISSection
3908
  open OASISGettext
3909
  open OASISUtils
3910

    
3911
  type std_args_fun =
3912
      package -> string array -> unit
3913

    
3914
  type ('a, 'b) section_args_fun =
3915
      name * (package -> (common_section * 'a) -> string array -> 'b)
3916

    
3917
  type t =
3918
      {
3919
        configure:        std_args_fun;
3920
        build:            std_args_fun;
3921
        doc:              ((doc, unit)  section_args_fun) list;
3922
        test:             ((test, float) section_args_fun) list;
3923
        install:          std_args_fun;
3924
        uninstall:        std_args_fun;
3925
        clean:            std_args_fun list;
3926
        clean_doc:        (doc, unit) section_args_fun list;
3927
        clean_test:       (test, unit) section_args_fun list;
3928
        distclean:        std_args_fun list;
3929
        distclean_doc:    (doc, unit) section_args_fun list;
3930
        distclean_test:   (test, unit) section_args_fun list;
3931
        package:          package;
3932
        oasis_fn:         string option;
3933
        oasis_version:    string;
3934
        oasis_digest:     Digest.t option;
3935
        oasis_exec:       string option;
3936
        oasis_setup_args: string list;
3937
        setup_update:     bool;
3938
      }
3939

    
3940
  (* Associate a plugin function with data from package *)
3941
  let join_plugin_sections filter_map lst =
3942
    List.rev
3943
      (List.fold_left
3944
         (fun acc sct ->
3945
            match filter_map sct with
3946
              | Some e ->
3947
                  e :: acc
3948
              | None ->
3949
                  acc)
3950
         []
3951
         lst)
3952

    
3953
  (* Search for plugin data associated with a section name *)
3954
  let lookup_plugin_section plugin action nm lst =
3955
    try
3956
      List.assoc nm lst
3957
    with Not_found ->
3958
      failwithf
3959
        (f_ "Cannot find plugin %s matching section %s for %s action")
3960
        plugin
3961
        nm
3962
        action
3963

    
3964
  let configure t args =
3965
    (* Run configure *)
3966
    BaseCustom.hook
3967
      t.package.conf_custom
3968
      (fun () -> 
3969
         (* Reload if preconf has changed it *)
3970
         begin
3971
           try
3972
             unload ();
3973
             load ();
3974
           with _ ->
3975
             ()
3976
         end;
3977

    
3978
         (* Run plugin's configure *)
3979
         t.configure t.package args;
3980

    
3981
         (* Dump to allow postconf to change it *)
3982
         dump ())
3983
      ();
3984

    
3985
    (* Reload environment *)
3986
    unload ();
3987
    load ();
3988

    
3989
    (* Save environment *)
3990
    print ();
3991

    
3992
    (* Replace data in file *)
3993
    BaseFileAB.replace t.package.files_ab
3994

    
3995
  let build t args =
3996
    BaseCustom.hook
3997
      t.package.build_custom
3998
      (t.build t.package)
3999
      args
4000

    
4001
  let doc t args =
4002
    BaseDoc.doc
4003
      (join_plugin_sections
4004
         (function
4005
            | Doc (cs, e) ->
4006
                Some
4007
                  (lookup_plugin_section
4008
                     "documentation"
4009
                     (s_ "build")
4010
                     cs.cs_name
4011
                     t.doc,
4012
                   cs,
4013
                   e)
4014
            | _ ->
4015
                None)
4016
         t.package.sections)
4017
      t.package
4018
      args
4019

    
4020
  let test t args =
4021
    BaseTest.test
4022
      (join_plugin_sections
4023
         (function
4024
            | Test (cs, e) ->
4025
                Some
4026
                  (lookup_plugin_section
4027
                     "test"
4028
                     (s_ "run")
4029
                     cs.cs_name
4030
                     t.test,
4031
                   cs,
4032
                   e)
4033
            | _ ->
4034
                None)
4035
         t.package.sections)
4036
      t.package
4037
      args
4038

    
4039
  let all t args =
4040
    let rno_doc =
4041
      ref false
4042
    in
4043
    let rno_test =
4044
      ref false
4045
    in
4046
      Arg.parse_argv
4047
        ~current:(ref 0)
4048
        (Array.of_list
4049
           ((Sys.executable_name^" all") ::
4050
            (Array.to_list args)))
4051
        [
4052
          "-no-doc",
4053
          Arg.Set rno_doc,
4054
          s_ "Don't run doc target";
4055

    
4056
          "-no-test",
4057
          Arg.Set rno_test,
4058
          s_ "Don't run test target";
4059
        ]
4060
        (failwithf (f_ "Don't know what to do with '%s'"))
4061
        "";
4062

    
4063
      info "Running configure step";
4064
      configure t [||];
4065

    
4066
      info "Running build step";
4067
      build     t [||];
4068

    
4069
      (* Load setup.log dynamic variables *)
4070
      BaseDynVar.init t.package;
4071

    
4072
      if not !rno_doc then
4073
        begin
4074
          info "Running doc step";
4075
          doc t [||];
4076
        end
4077
      else
4078
        begin
4079
          info "Skipping doc step"
4080
        end;
4081

    
4082
      if not !rno_test then
4083
        begin
4084
          info "Running test step";
4085
          test t [||]
4086
        end
4087
      else
4088
        begin
4089
          info "Skipping test step"
4090
        end
4091

    
4092
  let install t args =
4093
    BaseCustom.hook
4094
      t.package.install_custom
4095
      (t.install t.package)
4096
      args
4097

    
4098
  let uninstall t args =
4099
    BaseCustom.hook
4100
      t.package.uninstall_custom
4101
      (t.uninstall t.package)
4102
      args
4103

    
4104
  let reinstall t args =
4105
    uninstall t args;
4106
    install t args
4107

    
4108
  let clean, distclean =
4109
    let failsafe f a =
4110
      try
4111
        f a
4112
      with e ->
4113
        warning
4114
          (f_ "Action fail with error: %s")
4115
          (match e with
4116
             | Failure msg -> msg
4117
             | e -> Printexc.to_string e)
4118
    in
4119

    
4120
    let generic_clean t cstm mains docs tests args =
4121
      BaseCustom.hook
4122
        ~failsafe:true
4123
        cstm
4124
        (fun () ->
4125
           (* Clean section *)
4126
           List.iter
4127
             (function
4128
                | Test (cs, test) ->
4129
                    let f =
4130
                      try
4131
                        List.assoc cs.cs_name tests
4132
                      with Not_found ->
4133
                        fun _ _ _ -> ()
4134
                    in
4135
                      failsafe
4136
                        (f t.package (cs, test))
4137
                        args
4138
                | Doc (cs, doc) ->
4139
                    let f =
4140
                      try
4141
                        List.assoc cs.cs_name docs
4142
                      with Not_found ->
4143
                        fun _ _ _ -> ()
4144
                    in
4145
                      failsafe
4146
                        (f t.package (cs, doc))
4147
                        args
4148
                | Library _
4149
                | Executable _
4150
                | Flag _
4151
                | SrcRepo _ ->
4152
                    ())
4153
             t.package.sections;
4154
           (* Clean whole package *)
4155
           List.iter
4156
             (fun f ->
4157
                failsafe
4158
                  (f t.package)
4159
                  args)
4160
             mains)
4161
        ()
4162
    in
4163

    
4164
    let clean t args =
4165
      generic_clean
4166
        t
4167
        t.package.clean_custom
4168
        t.clean
4169
        t.clean_doc
4170
        t.clean_test
4171
        args
4172
    in
4173

    
4174
    let distclean t args =
4175
      (* Call clean *)
4176
      clean t args;
4177

    
4178
      (* Call distclean code *)
4179
      generic_clean
4180
        t
4181
        t.package.distclean_custom
4182
        t.distclean
4183
        t.distclean_doc
4184
        t.distclean_test
4185
        args;
4186

    
4187
      (* Remove generated file *)
4188
      List.iter
4189
        (fun fn ->
4190
           if Sys.file_exists fn then
4191
             begin
4192
               info (f_ "Remove '%s'") fn;
4193
               Sys.remove fn
4194
             end)
4195
        (BaseEnv.default_filename
4196
         ::
4197
         BaseLog.default_filename
4198
         ::
4199
         (List.rev_map BaseFileAB.to_filename t.package.files_ab))
4200
    in
4201

    
4202
      clean, distclean
4203

    
4204
  let version t _ =
4205
    print_endline t.oasis_version
4206

    
4207
  let update_setup_ml, no_update_setup_ml_cli =
4208
    let b = ref true in
4209
      b,
4210
      ("-no-update-setup-ml",
4211
       Arg.Clear b,
4212
       s_ " Don't try to update setup.ml, even if _oasis has changed.")
4213

    
4214
  let update_setup_ml t =
4215
    let oasis_fn =
4216
      match t.oasis_fn with
4217
        | Some fn -> fn
4218
        | None -> "_oasis"
4219
    in
4220
    let oasis_exec =
4221
      match t.oasis_exec with
4222
        | Some fn -> fn
4223
        | None -> "oasis"
4224
    in
4225
    let ocaml =
4226
      Sys.executable_name
4227
    in
4228
    let setup_ml, args =
4229
      match Array.to_list Sys.argv with
4230
        | setup_ml :: args ->
4231
            setup_ml, args
4232
        | [] ->
4233
            failwith
4234
              (s_ "Expecting non-empty command line arguments.")
4235
    in
4236
    let ocaml, setup_ml =
4237
      if Sys.executable_name = Sys.argv.(0) then
4238
        (* We are not running in standard mode, probably the script
4239
         * is precompiled.
4240
         *)
4241
        "ocaml", "setup.ml"
4242
      else
4243
        ocaml, setup_ml
4244
    in
4245
    let no_update_setup_ml_cli, _, _ = no_update_setup_ml_cli in
4246
    let do_update () =
4247
      let oasis_exec_version =
4248
        OASISExec.run_read_one_line
4249
          ~ctxt:!BaseContext.default
4250
          ~f_exit_code:
4251
          (function
4252
             | 0 ->
4253
                 ()
4254
             | 1 ->
4255
                 failwithf
4256
                   (f_ "Executable '%s' is probably an old version \
4257
                      of oasis (< 0.3.0), please update to version \
4258
                      v%s.")
4259
                   oasis_exec t.oasis_version
4260
             | 127 ->
4261
                 failwithf
4262
                   (f_ "Cannot find executable '%s', please install \
4263
                        oasis v%s.")
4264
                   oasis_exec t.oasis_version
4265
             | n ->
4266
                 failwithf
4267
                   (f_ "Command '%s version' exited with code %d.")
4268
                   oasis_exec n)
4269
          oasis_exec ["version"]
4270
      in
4271
        if OASISVersion.comparator_apply
4272
             (OASISVersion.version_of_string oasis_exec_version)
4273
             (OASISVersion.VGreaterEqual
4274
                (OASISVersion.version_of_string t.oasis_version)) then
4275
          begin
4276
            (* We have a version >= for the executable oasis, proceed with
4277
             * update.
4278
             *)
4279
            (* TODO: delegate this check to 'oasis setup'. *)
4280
            if Sys.os_type = "Win32" then
4281
              failwithf
4282
                (f_ "It is not possible to update the running script \
4283
                     setup.ml on Windows. Please update setup.ml by \
4284
                     running '%s'.")
4285
                (String.concat " " (oasis_exec :: "setup" :: t.oasis_setup_args))
4286
            else
4287
              begin
4288
                OASISExec.run
4289
                  ~ctxt:!BaseContext.default
4290
                  ~f_exit_code:
4291
                  (function
4292
                     | 0 ->
4293
                         ()
4294
                     | n ->
4295
                         failwithf
4296
                           (f_ "Unable to update setup.ml using '%s', \
4297
                                please fix the problem and retry.")
4298
                           oasis_exec)
4299
                  oasis_exec ("setup" :: t.oasis_setup_args);
4300
                OASISExec.run ~ctxt:!BaseContext.default ocaml (setup_ml :: args)
4301
              end
4302
          end
4303
        else
4304
          failwithf
4305
            (f_ "The version of '%s' (v%s) doesn't match the version of \
4306
                 oasis used to generate the %s file. Please install at \
4307
                 least oasis v%s.")
4308
            oasis_exec oasis_exec_version setup_ml t.oasis_version
4309
    in
4310

    
4311
    if !update_setup_ml then
4312
      begin
4313
        try
4314
          match t.oasis_digest with
4315
            | Some dgst ->
4316
              if Sys.file_exists oasis_fn && dgst <> Digest.file "_oasis" then
4317
                begin
4318
                  do_update ();
4319
                  true
4320
                end
4321
              else
4322
                false
4323
            | None ->
4324
                false
4325
        with e ->
4326
          error
4327
            (f_ "Error when updating setup.ml. If you want to avoid this error, \
4328
                 you can bypass the update of %s by running '%s %s %s %s'")
4329
            setup_ml ocaml setup_ml no_update_setup_ml_cli
4330
            (String.concat " " args);
4331
          raise e
4332
      end
4333
    else
4334
      false
4335

    
4336
  let setup t =
4337
    let catch_exn =
4338
      ref true
4339
    in
4340
      try
4341
        let act_ref =
4342
          ref (fun _ ->
4343
                 failwithf
4344
                   (f_ "No action defined, run '%s %s -help'")
4345
                   Sys.executable_name
4346
                   Sys.argv.(0))
4347

    
4348
        in
4349
        let extra_args_ref =
4350
          ref []
4351
        in
4352
        let allow_empty_env_ref =
4353
          ref false
4354
        in
4355
        let arg_handle ?(allow_empty_env=false) act =
4356
          Arg.Tuple
4357
            [
4358
              Arg.Rest (fun str -> extra_args_ref := str :: !extra_args_ref);
4359

    
4360
              Arg.Unit
4361
                (fun () ->
4362
                   allow_empty_env_ref := allow_empty_env;
4363
                   act_ref := act);
4364
            ]
4365
        in
4366

    
4367
          Arg.parse
4368
            (Arg.align
4369
               ([
4370
                 "-configure",
4371
                 arg_handle ~allow_empty_env:true configure,
4372
                 s_ "[options*] Configure the whole build process.";
4373

    
4374
                 "-build",
4375
                 arg_handle build,
4376
                 s_ "[options*] Build executables and libraries.";
4377

    
4378
                 "-doc",
4379
                 arg_handle doc,
4380
                 s_ "[options*] Build documents.";
4381

    
4382
                 "-test",
4383
                 arg_handle test,
4384
                 s_ "[options*] Run tests.";
4385

    
4386
                 "-all",
4387
                 arg_handle ~allow_empty_env:true all,
4388
                 s_ "[options*] Run configure, build, doc and test targets.";
4389

    
4390
                 "-install",
4391
                 arg_handle install,
4392
                 s_ "[options*] Install libraries, data, executables \
4393
                                and documents.";
4394

    
4395
                 "-uninstall",
4396
                 arg_handle uninstall,
4397
                 s_ "[options*] Uninstall libraries, data, executables \
4398
                                and documents.";
4399

    
4400
                 "-reinstall",
4401
                 arg_handle reinstall,
4402
                 s_ "[options*] Uninstall and install libraries, data, \
4403
                                executables and documents.";
4404

    
4405
                 "-clean",
4406
                 arg_handle ~allow_empty_env:true clean,
4407
                 s_ "[options*] Clean files generated by a build.";
4408

    
4409
                 "-distclean",
4410
                 arg_handle ~allow_empty_env:true distclean,
4411
                 s_ "[options*] Clean files generated by a build and configure.";
4412

    
4413
                 "-version",
4414
                 arg_handle ~allow_empty_env:true version,
4415
                 s_ " Display version of OASIS used to generate this setup.ml.";
4416

    
4417
                 "-no-catch-exn",
4418
                 Arg.Clear catch_exn,
4419
                 s_ " Don't catch exception, useful for debugging.";
4420
               ]
4421
               @
4422
                (if t.setup_update then
4423
                   [no_update_setup_ml_cli]
4424
                 else
4425
                   [])
4426
               @ (BaseContext.args ())))
4427
            (failwithf (f_ "Don't know what to do with '%s'"))
4428
            (s_ "Setup and run build process current package\n");
4429

    
4430
          (* Build initial environment *)
4431
          load ~allow_empty:!allow_empty_env_ref ();
4432

    
4433
          (** Initialize flags *)
4434
          List.iter
4435
            (function
4436
               | Flag (cs, {flag_description = hlp;
4437
                            flag_default = choices}) ->
4438
                   begin
4439
                     let apply ?short_desc () =
4440
                       var_ignore
4441
                         (var_define
4442
                            ~cli:CLIEnable
4443
                            ?short_desc
4444
                            (OASISUtils.varname_of_string cs.cs_name)
4445
                            (fun () ->
4446
                               string_of_bool
4447
                                 (var_choose
4448
                                    ~name:(Printf.sprintf
4449
                                             (f_ "default value of flag %s")
4450
                                             cs.cs_name)
4451
                                    ~printer:string_of_bool
4452
                                             choices)))
4453
                     in
4454
                       match hlp with
4455
                         | Some hlp ->
4456
                             apply ~short_desc:(fun () -> hlp) ()
4457
                         | None ->
4458
                             apply ()
4459
                   end
4460
               | _ ->
4461
                   ())
4462
            t.package.sections;
4463

    
4464
          BaseStandardVar.init t.package;
4465

    
4466
          BaseDynVar.init t.package;
4467

    
4468
          if t.setup_update && update_setup_ml t then
4469
            ()
4470
          else
4471
            !act_ref t (Array.of_list (List.rev !extra_args_ref))
4472

    
4473
      with e when !catch_exn ->
4474
        error "%s" (Printexc.to_string e);
4475
        exit 1
4476

    
4477
end
4478

    
4479

    
4480
# 4480 "setup.ml"
4481
module InternalConfigurePlugin = struct
4482
(* # 21 "/build/buildd/oasis-0.3.0/src/plugins/internal/InternalConfigurePlugin.ml" *)
4483

    
4484
  (** Configure using internal scheme
4485
      @author Sylvain Le Gall
4486
    *)
4487

    
4488
  open BaseEnv
4489
  open OASISTypes
4490
  open OASISUtils
4491
  open OASISGettext
4492
  open BaseMessage
4493

    
4494
  (** Configure build using provided series of check to be done
4495
    * and then output corresponding file.
4496
    *)
4497
  let configure pkg argv =
4498
    let var_ignore_eval var =
4499
      let _s : string =
4500
        var ()
4501
      in
4502
        ()
4503
    in
4504

    
4505
    let errors =
4506
      ref SetString.empty
4507
    in
4508

    
4509
    let buff =
4510
      Buffer.create 13
4511
    in
4512

    
4513
    let add_errors fmt =
4514
      Printf.kbprintf
4515
        (fun b ->
4516
           errors := SetString.add (Buffer.contents b) !errors;
4517
           Buffer.clear b)
4518
        buff
4519
        fmt
4520
    in
4521

    
4522
    let warn_exception e =
4523
      warning "%s" (Printexc.to_string e)
4524
    in
4525

    
4526
    (* Check tools *)
4527
    let check_tools lst =
4528
      List.iter
4529
        (function
4530
           | ExternalTool tool ->
4531
               begin
4532
                 try
4533
                   var_ignore_eval (BaseCheck.prog tool)
4534
                 with e ->
4535
                   warn_exception e;
4536
                   add_errors (f_ "Cannot find external tool '%s'") tool
4537
               end
4538
           | InternalExecutable nm1 ->
4539
               (* Check that matching tool is built *)
4540
               List.iter
4541
                 (function
4542
                    | Executable ({cs_name = nm2},
4543
                                  {bs_build = build},
4544
                                  _) when nm1 = nm2 ->
4545
                         if not (var_choose build) then
4546
                           add_errors
4547
                             (f_ "Cannot find buildable internal executable \
4548
                                  '%s' when checking build depends")
4549
                             nm1
4550
                    | _ ->
4551
                        ())
4552
                 pkg.sections)
4553
        lst
4554
    in
4555

    
4556
    let build_checks sct bs =
4557
      if var_choose bs.bs_build then
4558
        begin
4559
          if bs.bs_compiled_object = Native then
4560
            begin
4561
              try
4562
                var_ignore_eval BaseStandardVar.ocamlopt
4563
              with e ->
4564
                warn_exception e;
4565
                add_errors
4566
                  (f_ "Section %s requires native compilation")
4567
                  (OASISSection.string_of_section sct)
4568
            end;
4569

    
4570
          (* Check tools *)
4571
          check_tools bs.bs_build_tools;
4572

    
4573
          (* Check depends *)
4574
          List.iter
4575
            (function
4576
               | FindlibPackage (findlib_pkg, version_comparator) ->
4577
                   begin
4578
                     try
4579
                       var_ignore_eval
4580
                         (BaseCheck.package ?version_comparator findlib_pkg)
4581
                     with e ->
4582
                       warn_exception e;
4583
                       match version_comparator with
4584
                         | None ->
4585
                             add_errors
4586
                               (f_ "Cannot find findlib package %s")
4587
                               findlib_pkg
4588
                         | Some ver_cmp ->
4589
                             add_errors
4590
                               (f_ "Cannot find findlib package %s (%s)")
4591
                               findlib_pkg
4592
                               (OASISVersion.string_of_comparator ver_cmp)
4593
                   end
4594
               | InternalLibrary nm1 ->
4595
                   (* Check that matching library is built *)
4596
                   List.iter
4597
                     (function
4598
                        | Library ({cs_name = nm2},
4599
                                   {bs_build = build},
4600
                                   _) when nm1 = nm2 ->
4601
                             if not (var_choose build) then
4602
                               add_errors
4603
                                 (f_ "Cannot find buildable internal library \
4604
                                      '%s' when checking build depends")
4605
                                 nm1
4606
                        | _ ->
4607
                            ())
4608
                     pkg.sections)
4609
            bs.bs_build_depends
4610
        end
4611
    in
4612

    
4613
    (* Parse command line *)
4614
    BaseArgExt.parse argv (BaseEnv.args ());
4615

    
4616
    (* OCaml version *)
4617
    begin
4618
      match pkg.ocaml_version with
4619
        | Some ver_cmp ->
4620
            begin
4621
              try
4622
                var_ignore_eval
4623
                  (BaseCheck.version
4624
                     "ocaml"
4625
                     ver_cmp
4626
                     BaseStandardVar.ocaml_version)
4627
              with e ->
4628
                warn_exception e;
4629
                add_errors
4630
                  (f_ "OCaml version %s doesn't match version constraint %s")
4631
                  (BaseStandardVar.ocaml_version ())
4632
                  (OASISVersion.string_of_comparator ver_cmp)
4633
            end
4634
        | None ->
4635
            ()
4636
    end;
4637

    
4638
    (* Findlib version *)
4639
    begin
4640
      match pkg.findlib_version with
4641
        | Some ver_cmp ->
4642
            begin
4643
              try
4644
                var_ignore_eval
4645
                  (BaseCheck.version
4646
                     "findlib"
4647
                     ver_cmp
4648
                     BaseStandardVar.findlib_version)
4649
              with e ->
4650
                warn_exception e;
4651
                add_errors
4652
                  (f_ "Findlib version %s doesn't match version constraint %s")
4653
                  (BaseStandardVar.findlib_version ())
4654
                  (OASISVersion.string_of_comparator ver_cmp)
4655
            end
4656
        | None ->
4657
            ()
4658
    end;
4659

    
4660
    (* FlexDLL *)
4661
    if BaseStandardVar.os_type () = "Win32" ||
4662
       BaseStandardVar.os_type () = "Cygwin" then
4663
      begin
4664
        try
4665
          var_ignore_eval BaseStandardVar.flexlink
4666
        with e ->
4667
          warn_exception e;
4668
          add_errors (f_ "Cannot find 'flexlink'")
4669
      end;
4670

    
4671
    (* Check build depends *)
4672
    List.iter
4673
      (function
4674
         | Executable (_, bs, _)
4675
         | Library (_, bs, _) as sct ->
4676
             build_checks sct bs
4677
         | Doc (_, doc) ->
4678
             if var_choose doc.doc_build then
4679
               check_tools doc.doc_build_tools
4680
         | Test (_, test) ->
4681
             if var_choose test.test_run then
4682
               check_tools test.test_tools
4683
         | _ ->
4684
             ())
4685
      pkg.sections;
4686

    
4687
    (* Check if we need native dynlink (presence of libraries that compile to
4688
     * native)
4689
     *)
4690
    begin
4691
      let has_cmxa =
4692
        List.exists
4693
          (function
4694
             | Library (_, bs, _) ->
4695
                 var_choose bs.bs_build &&
4696
                 (bs.bs_compiled_object = Native ||
4697
                  (bs.bs_compiled_object = Best &&
4698
                   bool_of_string (BaseStandardVar.is_native ())))
4699
             | _  ->
4700
                 false)
4701
          pkg.sections
4702
      in
4703
        if has_cmxa then
4704
          var_ignore_eval BaseStandardVar.native_dynlink
4705
    end;
4706

    
4707
    (* Check errors *)
4708
    if SetString.empty != !errors then
4709
      begin
4710
        List.iter
4711
          (fun e -> error "%s" e)
4712
          (SetString.elements !errors);
4713
        failwithf
4714
          (fn_
4715
             "%d configuration error"
4716
             "%d configuration errors"
4717
             (SetString.cardinal !errors))
4718
          (SetString.cardinal !errors)
4719
      end
4720

    
4721
end
4722

    
4723
module InternalInstallPlugin = struct
4724
(* # 21 "/build/buildd/oasis-0.3.0/src/plugins/internal/InternalInstallPlugin.ml" *)
4725

    
4726
  (** Install using internal scheme
4727
      @author Sylvain Le Gall
4728
    *)
4729

    
4730
  open BaseEnv
4731
  open BaseStandardVar
4732
  open BaseMessage
4733
  open OASISTypes
4734
  open OASISLibrary
4735
  open OASISGettext
4736
  open OASISUtils
4737

    
4738
  let exec_hook =
4739
    ref (fun (cs, bs, exec) -> cs, bs, exec)
4740

    
4741
  let lib_hook =
4742
    ref (fun (cs, bs, lib) -> cs, bs, lib, [])
4743

    
4744
  let doc_hook =
4745
    ref (fun (cs, doc) -> cs, doc)
4746

    
4747
  let install_file_ev =
4748
    "install-file"
4749

    
4750
  let install_dir_ev =
4751
    "install-dir"
4752

    
4753
  let install_findlib_ev =
4754
    "install-findlib"
4755

    
4756
  let win32_max_command_line_length = 8000
4757

    
4758
  let split_install_command ocamlfind findlib_name meta files =
4759
    if Sys.os_type = "Win32" then
4760
      (* Arguments for the first command: *)
4761
      let first_args = ["install"; findlib_name; meta] in
4762
      (* Arguments for remaining commands: *)
4763
      let other_args = ["install"; findlib_name; "-add"] in
4764
      (* Extract as much files as possible from [files], [len] is
4765
         the current command line length: *)
4766
      let rec get_files len acc files =
4767
        match files with
4768
          | [] ->
4769
              (List.rev acc, [])
4770
          | file :: rest ->
4771
              let len = len + 1 + String.length file in
4772
              if len > win32_max_command_line_length then
4773
                (List.rev acc, files)
4774
              else
4775
                get_files len (file :: acc) rest
4776
      in
4777
      (* Split the command into several commands. *)
4778
      let rec split args files =
4779
        match files with
4780
          | [] ->
4781
              []
4782
          | _ ->
4783
              (* Length of "ocamlfind install <lib> [META|-add]" *)
4784
              let len =
4785
                List.fold_left
4786
                  (fun len arg ->
4787
                     len + 1 (* for the space *) + String.length arg)
4788
                  (String.length ocamlfind)
4789
                  args
4790
              in
4791
              match get_files len [] files with
4792
                | ([], _) ->
4793
                    failwith (s_ "Command line too long.")
4794
                | (firsts, others) ->
4795
                    let cmd = args @ firsts in
4796
                    (* Use -add for remaining commands: *)
4797
                    let () = 
4798
                      let findlib_ge_132 =
4799
                        OASISVersion.comparator_apply
4800
                          (OASISVersion.version_of_string 
4801
                             (BaseStandardVar.findlib_version ()))
4802
                          (OASISVersion.VGreaterEqual 
4803
                             (OASISVersion.version_of_string "1.3.2"))
4804
                      in
4805
                        if not findlib_ge_132 then
4806
                          failwithf
4807
                            (f_ "Installing the library %s require to use the flag \
4808
                                 '-add' of ocamlfind because the command line is too \
4809
                                  long. This flag is only available for findlib 1.3.2. \
4810
                                  Please upgrade findlib from %s to 1.3.2")
4811
                            findlib_name (BaseStandardVar.findlib_version ())
4812
                    in
4813
                    let cmds = split other_args others in
4814
                    cmd :: cmds
4815
      in
4816
      (* The first command does not use -add: *)
4817
      split first_args files
4818
    else
4819
      ["install" :: findlib_name :: meta :: files]
4820

    
4821
  let install pkg argv =
4822

    
4823
    let in_destdir =
4824
      try
4825
        let destdir =
4826
          destdir ()
4827
        in
4828
          (* Practically speaking destdir is prepended
4829
           * at the beginning of the target filename
4830
           *)
4831
          fun fn -> destdir^fn
4832
      with PropList.Not_set _ ->
4833
        fun fn -> fn
4834
    in
4835

    
4836
    let install_file ?tgt_fn src_file envdir =
4837
      let tgt_dir =
4838
        in_destdir (envdir ())
4839
      in
4840
      let tgt_file =
4841
        Filename.concat
4842
          tgt_dir
4843
          (match tgt_fn with
4844
             | Some fn ->
4845
                 fn
4846
             | None ->
4847
                 Filename.basename src_file)
4848
      in
4849
        (* Create target directory if needed *)
4850
        OASISFileUtil.mkdir_parent
4851
          ~ctxt:!BaseContext.default
4852
          (fun dn ->
4853
             info (f_ "Creating directory '%s'") dn;
4854
             BaseLog.register install_dir_ev dn)
4855
          tgt_dir;
4856

    
4857
        (* Really install files *)
4858
        info (f_ "Copying file '%s' to '%s'") src_file tgt_file;
4859
        OASISFileUtil.cp ~ctxt:!BaseContext.default src_file tgt_file;
4860
        BaseLog.register install_file_ev tgt_file
4861
    in
4862

    
4863
    (* Install data into defined directory *)
4864
    let install_data srcdir lst tgtdir =
4865
      let tgtdir =
4866
        OASISHostPath.of_unix (var_expand tgtdir)
4867
      in
4868
        List.iter
4869
          (fun (src, tgt_opt) ->
4870
             let real_srcs =
4871
               OASISFileUtil.glob
4872
                 ~ctxt:!BaseContext.default
4873
                 (Filename.concat srcdir src)
4874
             in
4875
               if real_srcs = [] then
4876
                 failwithf
4877
                   (f_ "Wildcard '%s' doesn't match any files")
4878
                   src;
4879
               List.iter
4880
                 (fun fn ->
4881
                    install_file
4882
                      fn
4883
                      (fun () ->
4884
                         match tgt_opt with
4885
                           | Some s ->
4886
                               OASISHostPath.of_unix (var_expand s)
4887
                           | None ->
4888
                               tgtdir))
4889
                 real_srcs)
4890
          lst
4891
    in
4892

    
4893
    (** Install all libraries *)
4894
    let install_libs pkg =
4895

    
4896
      let files_of_library (f_data, acc) data_lib =
4897
        let cs, bs, lib, lib_extra =
4898
          !lib_hook data_lib
4899
        in
4900
          if var_choose bs.bs_install &&
4901
             BaseBuilt.is_built BaseBuilt.BLib cs.cs_name then
4902
            begin
4903
              let acc =
4904
                (* Start with acc + lib_extra *)
4905
                List.rev_append lib_extra acc
4906
              in
4907
              let acc =
4908
                (* Add uncompiled header from the source tree *)
4909
                let path =
4910
                  OASISHostPath.of_unix bs.bs_path
4911
                in
4912
                  List.fold_left
4913
                    (fun acc modul ->
4914
                       try
4915
                         List.find
4916
                           OASISFileUtil.file_exists_case
4917
                           (List.map
4918
                              (Filename.concat path)
4919
                              [modul^".mli";
4920
                               modul^".ml";
4921
                               String.uncapitalize modul^".mli";
4922
                               String.capitalize   modul^".mli";
4923
                               String.uncapitalize modul^".ml";
4924
                               String.capitalize   modul^".ml"])
4925
                         :: acc
4926
                       with Not_found ->
4927
                         begin
4928
                           warning
4929
                             (f_ "Cannot find source header for module %s \
4930
                                  in library %s")
4931
                             modul cs.cs_name;
4932
                           acc
4933
                         end)
4934
                    acc
4935
                    lib.lib_modules
4936
              in
4937

    
4938
              let acc =
4939
               (* Get generated files *)
4940
               BaseBuilt.fold
4941
                 BaseBuilt.BLib
4942
                 cs.cs_name
4943
                 (fun acc fn -> fn :: acc)
4944
                 acc
4945
              in
4946

    
4947
              let f_data () =
4948
                (* Install data associated with the library *)
4949
                install_data
4950
                  bs.bs_path
4951
                  bs.bs_data_files
4952
                  (Filename.concat
4953
                     (datarootdir ())
4954
                     pkg.name);
4955
                f_data ()
4956
              in
4957

    
4958
                (f_data, acc)
4959
            end
4960
           else
4961
            begin
4962
              (f_data, acc)
4963
            end
4964
      in
4965

    
4966
      (* Install one group of library *)
4967
      let install_group_lib grp =
4968
        (* Iterate through all group nodes *)
4969
        let rec install_group_lib_aux data_and_files grp =
4970
          let data_and_files, children =
4971
            match grp with
4972
              | Container (_, children) ->
4973
                  data_and_files, children
4974
              | Package (_, cs, bs, lib, children) ->
4975
                  files_of_library data_and_files (cs, bs, lib), children
4976
          in
4977
            List.fold_left
4978
              install_group_lib_aux
4979
              data_and_files
4980
              children
4981
        in
4982

    
4983
        (* Findlib name of the root library *)
4984
        let findlib_name =
4985
          findlib_of_group grp
4986
        in
4987

    
4988
        (* Determine root library *)
4989
        let root_lib =
4990
          root_of_group grp
4991
        in
4992

    
4993
        (* All files to install for this library *)
4994
        let f_data, files =
4995
          install_group_lib_aux (ignore, []) grp
4996
        in
4997

    
4998
          (* Really install, if there is something to install *)
4999
          if files = [] then
5000
            begin
5001
              warning
5002
                (f_ "Nothing to install for findlib library '%s'")
5003
                findlib_name
5004
            end
5005
          else
5006
            begin
5007
              let meta =
5008
                (* Search META file *)
5009
                let (_, bs, _) =
5010
                  root_lib
5011
                in
5012
                let res =
5013
                  Filename.concat bs.bs_path "META"
5014
                in
5015
                  if not (OASISFileUtil.file_exists_case res) then
5016
                    failwithf
5017
                      (f_ "Cannot find file '%s' for findlib library %s")
5018
                      res
5019
                      findlib_name;
5020
                  res
5021
              in
5022
              let files = 
5023
                (* Make filename shorter to avoid hitting command max line length
5024
                 * too early, esp. on Windows.
5025
                 *)
5026
                let remove_prefix p n =
5027
                  let plen = String.length p in
5028
                  let nlen = String.length n in
5029
                    if plen <= nlen && String.sub n 0 plen = p then
5030
                      begin
5031
                        let fn_sep = 
5032
                          if Sys.os_type = "Win32" then
5033
                            '\\'
5034
                          else
5035
                            '/'
5036
                        in
5037
                        let cutpoint = plen +
5038
                          (if plen < nlen && n.[plen] = fn_sep then 
5039
                             1
5040
                           else 
5041
                             0)
5042
                        in
5043
                          String.sub n cutpoint (nlen - cutpoint)
5044
                      end
5045
                    else 
5046
                      n
5047
                in
5048
                  List.map (remove_prefix (Sys.getcwd ())) files 
5049
              in
5050
                info
5051
                  (f_ "Installing findlib library '%s'")
5052
                  findlib_name;
5053
                let ocamlfind = ocamlfind () in
5054
                let commands =
5055
                  split_install_command
5056
                    ocamlfind
5057
                    findlib_name
5058
                    meta
5059
                    files
5060
                in
5061
                List.iter
5062
                  (OASISExec.run ~ctxt:!BaseContext.default ocamlfind)
5063
                  commands;
5064
                BaseLog.register install_findlib_ev findlib_name
5065
            end;
5066

    
5067
          (* Install data files *)
5068
          f_data ();
5069

    
5070
      in
5071

    
5072
      let group_libs, _, _ =
5073
        findlib_mapping pkg
5074
      in
5075

    
5076
        (* We install libraries in groups *)
5077
        List.iter install_group_lib group_libs
5078
    in
5079

    
5080
    let install_execs pkg =
5081
      let install_exec data_exec =
5082
        let (cs, bs, exec) =
5083
          !exec_hook data_exec
5084
        in
5085
          if var_choose bs.bs_install &&
5086
             BaseBuilt.is_built BaseBuilt.BExec cs.cs_name then
5087
            begin
5088
              let exec_libdir () =
5089
                Filename.concat
5090
                  (libdir ())
5091
                  pkg.name
5092
              in
5093
                BaseBuilt.fold
5094
                  BaseBuilt.BExec
5095
                  cs.cs_name
5096
                  (fun () fn ->
5097
                     install_file
5098
                       ~tgt_fn:(cs.cs_name ^ ext_program ())
5099
                       fn
5100
                       bindir)
5101
                  ();
5102
                BaseBuilt.fold
5103
                  BaseBuilt.BExecLib
5104
                  cs.cs_name
5105
                  (fun () fn ->
5106
                     install_file
5107
                       fn
5108
                       exec_libdir)
5109
                  ();
5110
                install_data
5111
                  bs.bs_path
5112
                  bs.bs_data_files
5113
                  (Filename.concat
5114
                     (datarootdir ())
5115
                     pkg.name)
5116
            end
5117
      in
5118
        List.iter
5119
          (function
5120
             | Executable (cs, bs, exec)->
5121
                 install_exec (cs, bs, exec)
5122
             | _ ->
5123
                 ())
5124
          pkg.sections
5125
    in
5126

    
5127
    let install_docs pkg =
5128
      let install_doc data =
5129
        let (cs, doc) =
5130
          !doc_hook data
5131
        in
5132
          if var_choose doc.doc_install &&
5133
             BaseBuilt.is_built BaseBuilt.BDoc cs.cs_name then
5134
            begin
5135
              let tgt_dir =
5136
                OASISHostPath.of_unix (var_expand doc.doc_install_dir)
5137
              in
5138
                BaseBuilt.fold
5139
                  BaseBuilt.BDoc
5140
                  cs.cs_name
5141
                  (fun () fn ->
5142
                     install_file
5143
                       fn
5144
                       (fun () -> tgt_dir))
5145
                ();
5146
                install_data
5147
                  Filename.current_dir_name
5148
                  doc.doc_data_files
5149
                  doc.doc_install_dir
5150
            end
5151
      in
5152
        List.iter
5153
          (function
5154
             | Doc (cs, doc) ->
5155
                 install_doc (cs, doc)
5156
             | _ ->
5157
                 ())
5158
          pkg.sections
5159
    in
5160

    
5161
      install_libs  pkg;
5162
      install_execs pkg;
5163
      install_docs  pkg
5164

    
5165
  (* Uninstall already installed data *)
5166
  let uninstall _ argv =
5167
    List.iter
5168
      (fun (ev, data) ->
5169
         if ev = install_file_ev then
5170
           begin
5171
             if OASISFileUtil.file_exists_case data then
5172
               begin
5173
                 info
5174
                   (f_ "Removing file '%s'")
5175
                   data;
5176
                 Sys.remove data
5177
               end
5178
             else
5179
               begin
5180
                 warning
5181
                   (f_ "File '%s' doesn't exist anymore")
5182
                   data
5183
               end
5184
           end
5185
         else if ev = install_dir_ev then
5186
           begin
5187
             if Sys.file_exists data && Sys.is_directory data then
5188
               begin
5189
                 if Sys.readdir data = [||] then
5190
                   begin
5191
                     info
5192
                       (f_ "Removing directory '%s'")
5193
                       data;
5194
                     OASISFileUtil.rmdir ~ctxt:!BaseContext.default data
5195
                   end
5196
                 else
5197
                   begin
5198
                     warning
5199
                       (f_ "Directory '%s' is not empty (%s)")
5200
                       data
5201
                       (String.concat
5202
                          ", "
5203
                          (Array.to_list
5204
                             (Sys.readdir data)))
5205
                   end
5206
               end
5207
             else
5208
               begin
5209
                 warning
5210
                   (f_ "Directory '%s' doesn't exist anymore")
5211
                   data
5212
               end
5213
           end
5214
         else if ev = install_findlib_ev then
5215
           begin
5216
             info (f_ "Removing findlib library '%s'") data;
5217
             OASISExec.run ~ctxt:!BaseContext.default
5218
               (ocamlfind ()) ["remove"; data]
5219
           end
5220
         else
5221
           failwithf (f_ "Unknown log event '%s'") ev;
5222
         BaseLog.unregister ev data)
5223
      (* We process event in reverse order *)
5224
      (List.rev
5225
         (BaseLog.filter
5226
            [install_file_ev;
5227
             install_dir_ev;
5228
             install_findlib_ev;]))
5229

    
5230
end
5231

    
5232

    
5233
# 5233 "setup.ml"
5234
module OCamlbuildCommon = struct
5235
(* # 21 "/build/buildd/oasis-0.3.0/src/plugins/ocamlbuild/OCamlbuildCommon.ml" *)
5236

    
5237
  (** Functions common to OCamlbuild build and doc plugin
5238
    *)
5239

    
5240
  open OASISGettext
5241
  open BaseEnv
5242
  open BaseStandardVar
5243

    
5244
  let ocamlbuild_clean_ev =
5245
    "ocamlbuild-clean"
5246

    
5247
  let ocamlbuildflags =
5248
    var_define
5249
      ~short_desc:(fun () -> "OCamlbuild additional flags")
5250
      "ocamlbuildflags"
5251
      (fun () -> "")
5252

    
5253
  (** Fix special arguments depending on environment *)
5254
  let fix_args args extra_argv =
5255
    List.flatten
5256
      [
5257
        if (os_type ()) = "Win32" then
5258
          [
5259
            "-classic-display";
5260
            "-no-log";
5261
            "-no-links";
5262
            "-install-lib-dir";
5263
            (Filename.concat (standard_library ()) "ocamlbuild")
5264
          ]
5265
        else
5266
          [];
5267

    
5268
        if not (bool_of_string (is_native ())) || (os_type ()) = "Win32" then
5269
          [
5270
            "-byte-plugin"
5271
          ]
5272
        else
5273
          [];
5274
        args;
5275

    
5276
        if bool_of_string (debug ()) then
5277
          ["-tag"; "debug"]
5278
        else
5279
          [];
5280

    
5281
        if bool_of_string (profile ()) then
5282
          ["-tag"; "profile"]
5283
        else
5284
          [];
5285

    
5286
        OASISString.nsplit (ocamlbuildflags ()) ' ';
5287

    
5288
        Array.to_list extra_argv;
5289
      ]
5290

    
5291
  (** Run 'ocamlbuild -clean' if not already done *)
5292
  let run_clean extra_argv =
5293
    let extra_cli =
5294
      String.concat " " (Array.to_list extra_argv)
5295
    in
5296
      (* Run if never called with these args *)
5297
      if not (BaseLog.exists ocamlbuild_clean_ev extra_cli) then
5298
        begin
5299
          OASISExec.run ~ctxt:!BaseContext.default
5300
            (ocamlbuild ()) (fix_args ["-clean"] extra_argv);
5301
          BaseLog.register ocamlbuild_clean_ev extra_cli;
5302
          at_exit
5303
            (fun () ->
5304
               try
5305
                 BaseLog.unregister ocamlbuild_clean_ev extra_cli
5306
               with _ ->
5307
                 ())
5308
        end
5309

    
5310
  (** Run ocamlbuild, unregister all clean events *)
5311
  let run_ocamlbuild args extra_argv =
5312
    (* TODO: enforce that target in args must be UNIX encoded i.e. toto/index.html
5313
     *)
5314
    OASISExec.run ~ctxt:!BaseContext.default
5315
      (ocamlbuild ()) (fix_args args extra_argv);
5316
    (* Remove any clean event, we must run it again *)
5317
    List.iter
5318
      (fun (e, d) -> BaseLog.unregister e d)
5319
      (BaseLog.filter [ocamlbuild_clean_ev])
5320

    
5321
  (** Determine real build directory *)
5322
  let build_dir extra_argv =
5323
    let rec search_args dir =
5324
      function
5325
        | "-build-dir" :: dir :: tl ->
5326
            search_args dir tl
5327
        | _ :: tl ->
5328
            search_args dir tl
5329
        | [] ->
5330
            dir
5331
    in
5332
      search_args "_build" (fix_args [] extra_argv)
5333

    
5334
end
5335

    
5336
module OCamlbuildPlugin = struct
5337
(* # 21 "/build/buildd/oasis-0.3.0/src/plugins/ocamlbuild/OCamlbuildPlugin.ml" *)
5338

    
5339
  (** Build using ocamlbuild
5340
      @author Sylvain Le Gall
5341
    *)
5342

    
5343
  open OASISTypes
5344
  open OASISGettext
5345
  open OASISUtils
5346
  open BaseEnv
5347
  open OCamlbuildCommon
5348
  open BaseStandardVar
5349
  open BaseMessage
5350

    
5351
  let cond_targets_hook =
5352
    ref (fun lst -> lst)
5353

    
5354
  let build pkg argv =
5355

    
5356
    (* Return the filename in build directory *)
5357
    let in_build_dir fn =
5358
      Filename.concat
5359
        (build_dir argv)
5360
        fn
5361
    in
5362

    
5363
    (* Return the unix filename in host build directory *)
5364
    let in_build_dir_of_unix fn =
5365
      in_build_dir (OASISHostPath.of_unix fn)
5366
    in
5367

    
5368
    let cond_targets =
5369
      List.fold_left
5370
        (fun acc ->
5371
           function
5372
             | Library (cs, bs, lib) when var_choose bs.bs_build ->
5373
                 begin
5374
                   let evs, unix_files =
5375
                     BaseBuilt.of_library
5376
                       in_build_dir_of_unix
5377
                       (cs, bs, lib)
5378
                   in
5379

    
5380
                   let ends_with nd fn =
5381
                     let nd_len =
5382
                       String.length nd
5383
                     in
5384
                       (String.length fn >= nd_len)
5385
                       &&
5386
                       (String.sub
5387
                          fn
5388
                          (String.length fn - nd_len)
5389
                          nd_len) = nd
5390
                   in
5391

    
5392
                   let tgts =
5393
                     List.flatten
5394
                       (List.filter
5395
                          (fun l -> l <> [])
5396
                          (List.map
5397
                             (List.filter
5398
                                (fun fn ->
5399
                                 ends_with ".cma" fn
5400
                                 || ends_with ".cmxs" fn
5401
                                 || ends_with ".cmxa" fn
5402
                                 || ends_with (ext_lib ()) fn
5403
                                 || ends_with (ext_dll ()) fn))
5404
                             unix_files))
5405
                   in
5406

    
5407
                     match tgts with
5408
                       | _ :: _ ->
5409
                           (evs, tgts) :: acc
5410
                       | [] ->
5411
                           failwithf
5412
                             (f_ "No possible ocamlbuild targets for library %s")
5413
                             cs.cs_name
5414
                 end
5415

    
5416
             | Executable (cs, bs, exec) when var_choose bs.bs_build ->
5417
                 begin
5418
                   let evs, unix_exec_is, unix_dll_opt =
5419
                     BaseBuilt.of_executable
5420
                       in_build_dir_of_unix
5421
                       (cs, bs, exec)
5422
                   in
5423

    
5424
                   let target ext =
5425
                     let unix_tgt =
5426
                       (OASISUnixPath.concat
5427
                          bs.bs_path
5428
                          (OASISUnixPath.chop_extension
5429
                             exec.exec_main_is))^ext
5430
                     in
5431
                     let evs = 
5432
                       (* Fix evs, we want to use the unix_tgt, without copying *)
5433
                       List.map
5434
                         (function
5435
                            | BaseBuilt.BExec, nm, lst when nm = cs.cs_name ->
5436
                                BaseBuilt.BExec, nm, [[in_build_dir_of_unix unix_tgt]]
5437
                            | ev ->
5438
                                ev)
5439
                         evs
5440
                     in
5441
                       evs, [unix_tgt]
5442
                   in
5443

    
5444
                   (* Add executable *)
5445
                   let acc =
5446
                     match bs.bs_compiled_object with
5447
                       | Native ->
5448
                           (target ".native") :: acc
5449
                       | Best when bool_of_string (is_native ()) ->
5450
                           (target ".native") :: acc
5451
                       | Byte
5452
                       | Best ->
5453
                           (target ".byte") :: acc
5454
                   in
5455
                     acc
5456
                 end
5457

    
5458
             | Library _ | Executable _ | Test _
5459
             | SrcRepo _ | Flag _ | Doc _ ->
5460
                 acc)
5461
        []
5462
        (* Keep the pkg.sections ordered *)
5463
        (List.rev pkg.sections);
5464
    in
5465

    
5466
    (* Check and register built files *)
5467
    let check_and_register (bt, bnm, lst) =
5468
      List.iter
5469
        (fun fns ->
5470
           if not (List.exists OASISFileUtil.file_exists_case fns) then
5471
             failwithf
5472
               (f_ "No one of expected built files %s exists")
5473
               (String.concat (s_ ", ") (List.map (Printf.sprintf "'%s'") fns)))
5474
        lst;
5475
        (BaseBuilt.register bt bnm lst)
5476
    in
5477

    
5478
    let cond_targets =
5479
      (* Run the hook *)
5480
      !cond_targets_hook cond_targets
5481
    in
5482

    
5483
      (* Run a list of target... *)
5484
      run_ocamlbuild 
5485
        (List.flatten 
5486
           (List.map snd cond_targets))
5487
        argv;
5488
      (* ... and register events *)
5489
      List.iter
5490
        check_and_register
5491
        (List.flatten (List.map fst cond_targets))
5492

    
5493

    
5494
  let clean pkg extra_args  =
5495
    run_clean extra_args;
5496
    List.iter
5497
      (function
5498
         | Library (cs, _, _) ->
5499
             BaseBuilt.unregister BaseBuilt.BLib cs.cs_name
5500
         | Executable (cs, _, _) ->
5501
             BaseBuilt.unregister BaseBuilt.BExec cs.cs_name;
5502
             BaseBuilt.unregister BaseBuilt.BExecLib cs.cs_name
5503
         | _ ->
5504
             ())
5505
      pkg.sections
5506

    
5507
end
5508

    
5509
module OCamlbuildDocPlugin = struct
5510
(* # 21 "/build/buildd/oasis-0.3.0/src/plugins/ocamlbuild/OCamlbuildDocPlugin.ml" *)
5511

    
5512
  (* Create documentation using ocamlbuild .odocl files
5513
     @author Sylvain Le Gall
5514
   *)
5515

    
5516
  open OASISTypes
5517
  open OASISGettext
5518
  open OASISMessage
5519
  open OCamlbuildCommon
5520
  open BaseStandardVar
5521

    
5522

    
5523

    
5524
  let doc_build path pkg (cs, doc) argv =
5525
    let index_html =
5526
      OASISUnixPath.make
5527
        [
5528
          path;
5529
          cs.cs_name^".docdir";
5530
          "index.html";
5531
        ]
5532
    in
5533
    let tgt_dir =
5534
      OASISHostPath.make
5535
        [
5536
          build_dir argv;
5537
          OASISHostPath.of_unix path;
5538
          cs.cs_name^".docdir";
5539
        ]
5540
    in
5541
      run_ocamlbuild [index_html] argv;
5542
      List.iter
5543
        (fun glb ->
5544
           BaseBuilt.register
5545
             BaseBuilt.BDoc
5546
             cs.cs_name
5547
             [OASISFileUtil.glob ~ctxt:!BaseContext.default
5548
                (Filename.concat tgt_dir glb)])
5549
        ["*.html"; "*.css"]
5550

    
5551
  let doc_clean t pkg (cs, doc) argv =
5552
    run_clean argv;
5553
    BaseBuilt.unregister BaseBuilt.BDoc cs.cs_name
5554

    
5555
end
5556

    
5557

    
5558
# 5558 "setup.ml"
5559
module CustomPlugin = struct
5560
(* # 21 "/build/buildd/oasis-0.3.0/src/plugins/custom/CustomPlugin.ml" *)
5561

    
5562
  (** Generate custom configure/build/doc/test/install system
5563
      @author
5564
    *)
5565

    
5566
  open BaseEnv
5567
  open OASISGettext
5568
  open OASISTypes
5569

    
5570

    
5571

    
5572
  type t =
5573
      {
5574
        cmd_main:      command_line conditional;
5575
        cmd_clean:     (command_line option) conditional;
5576
        cmd_distclean: (command_line option) conditional;
5577
      } 
5578

    
5579
  let run  = BaseCustom.run 
5580

    
5581
  let main t _ extra_args =
5582
    let cmd, args =
5583
      var_choose 
5584
        ~name:(s_ "main command") 
5585
        t.cmd_main
5586
    in
5587
      run cmd args extra_args 
5588

    
5589
  let clean t pkg extra_args =
5590
    match var_choose t.cmd_clean with
5591
      | Some (cmd, args) ->
5592
          run cmd args extra_args
5593
      | _ ->
5594
          ()
5595

    
5596
  let distclean t pkg extra_args =
5597
    match var_choose t.cmd_distclean with
5598
      | Some (cmd, args) ->
5599
          run cmd args extra_args
5600
      | _ ->
5601
          ()
5602

    
5603
  module Build =
5604
  struct 
5605
    let main t pkg extra_args =
5606
      main t pkg extra_args;
5607
      List.iter
5608
        (fun sct ->
5609
           let evs =
5610
             match sct with 
5611
               | Library (cs, bs, lib) when var_choose bs.bs_build ->
5612
                   begin
5613
                     let evs, _ = 
5614
                       BaseBuilt.of_library 
5615
                         OASISHostPath.of_unix
5616
                         (cs, bs, lib) 
5617
                     in
5618
                       evs
5619
                   end
5620
               | Executable (cs, bs, exec) when var_choose bs.bs_build ->
5621
                   begin
5622
                     let evs, _, _ =
5623
                       BaseBuilt.of_executable
5624
                         OASISHostPath.of_unix
5625
                         (cs, bs, exec)
5626
                     in
5627
                       evs
5628
                   end
5629
               | _ ->
5630
                   []
5631
           in
5632
             List.iter
5633
               (fun (bt, bnm, lst) -> BaseBuilt.register bt bnm lst)
5634
               evs)
5635
        pkg.sections
5636

    
5637
    let clean t pkg extra_args =
5638
      clean t pkg extra_args;
5639
      (* TODO: this seems to be pretty generic (at least wrt to ocamlbuild
5640
       * considering moving this to BaseSetup?
5641
       *)
5642
      List.iter
5643
        (function
5644
           | Library (cs, _, _) ->
5645
               BaseBuilt.unregister BaseBuilt.BLib cs.cs_name
5646
           | Executable (cs, _, _) ->
5647
               BaseBuilt.unregister BaseBuilt.BExec cs.cs_name;
5648
               BaseBuilt.unregister BaseBuilt.BExecLib cs.cs_name
5649
           | _ ->
5650
               ())
5651
        pkg.sections
5652

    
5653
    let distclean t pkg extra_args =
5654
      distclean t pkg extra_args
5655
  end
5656

    
5657
  module Test =
5658
  struct
5659
    let main t pkg (cs, test) extra_args =
5660
      try
5661
        main t pkg extra_args;
5662
        0.0
5663
      with Failure s ->
5664
        BaseMessage.warning 
5665
          (f_ "Test '%s' fails: %s")
5666
          cs.cs_name
5667
          s;
5668
        1.0
5669

    
5670
    let clean t pkg (cs, test) extra_args =
5671
      clean t pkg extra_args
5672

    
5673
    let distclean t pkg (cs, test) extra_args =
5674
      distclean t pkg extra_args 
5675
  end
5676

    
5677
  module Doc =
5678
  struct
5679
    let main t pkg (cs, _) extra_args =
5680
      main t pkg extra_args;
5681
      BaseBuilt.register BaseBuilt.BDoc cs.cs_name []
5682

    
5683
    let clean t pkg (cs, _) extra_args =
5684
      clean t pkg extra_args;
5685
      BaseBuilt.unregister BaseBuilt.BDoc cs.cs_name
5686

    
5687
    let distclean t pkg (cs, _) extra_args =
5688
      distclean t pkg extra_args
5689
  end
5690

    
5691
end
5692

    
5693

    
5694
# 5694 "setup.ml"
5695
open OASISTypes;;
5696

    
5697
let setup_t =
5698
  {
5699
     BaseSetup.configure = InternalConfigurePlugin.configure;
5700
     build = OCamlbuildPlugin.build;
5701
     test =
5702
       [
5703
          ("nonregression",
5704
            CustomPlugin.Test.main
5705
              {
5706
                 CustomPlugin.cmd_main =
5707
                   [(OASISExpr.EBool true, ("make", ["test-compile"]))];
5708
                 cmd_clean = [(OASISExpr.EBool true, None)];
5709
                 cmd_distclean = [(OASISExpr.EBool true, None)];
5710
                 })
5711
       ];
5712
     doc = [];
5713
     install = InternalInstallPlugin.install;
5714
     uninstall = InternalInstallPlugin.uninstall;
5715
     clean = [OCamlbuildPlugin.clean];
5716
     clean_test =
5717
       [
5718
          ("nonregression",
5719
            CustomPlugin.Test.clean
5720
              {
5721
                 CustomPlugin.cmd_main =
5722
                   [(OASISExpr.EBool true, ("make", ["test-compile"]))];
5723
                 cmd_clean = [(OASISExpr.EBool true, None)];
5724
                 cmd_distclean = [(OASISExpr.EBool true, None)];
5725
                 })
5726
       ];
5727
     clean_doc = [];
5728
     distclean = [];
5729
     distclean_test =
5730
       [
5731
          ("nonregression",
5732
            CustomPlugin.Test.distclean
5733
              {
5734
                 CustomPlugin.cmd_main =
5735
                   [(OASISExpr.EBool true, ("make", ["test-compile"]))];
5736
                 cmd_clean = [(OASISExpr.EBool true, None)];
5737
                 cmd_distclean = [(OASISExpr.EBool true, None)];
5738
                 })
5739
       ];
5740
     distclean_doc = [];
5741
     package =
5742
       {
5743
          oasis_version = "0.2";
5744
          ocaml_version = None;
5745
          findlib_version = None;
5746
          name = "Lustre Compiler";
5747
          version = "1.2";
5748
          license =
5749
            OASISLicense.DEP5License
5750
              (OASISLicense.DEP5Unit
5751
                 {
5752
                    OASISLicense.license = "LGPL";
5753
                    excption = None;
5754
                    version = OASISLicense.Version "2.1";
5755
                    });
5756
          license_file = None;
5757
          copyrights = [];
5758
          maintainers = [];
5759
          authors = [];
5760
          homepage = None;
5761
          synopsis = "Lustre compiler C and Java backends";
5762
          description = None;
5763
          categories = [];
5764
          conf_type = (`Configure, "internal", Some "0.3");
5765
          conf_custom =
5766
            {
5767
               pre_command = [(OASISExpr.EBool true, None)];
5768
               post_command = [(OASISExpr.EBool true, None)];
5769
               };
5770
          build_type = (`Build, "ocamlbuild", Some "0.3");
5771
          build_custom =
5772
            {
5773
               pre_command =
5774
                 [
5775
                    (OASISExpr.EBool true,
5776
                      Some (("./svn_version.sh", ["$(prefix)"])))
5777
                 ];
5778
               post_command = [(OASISExpr.EBool true, None)];
5779
               };
5780
          install_type = (`Install, "internal", Some "0.3");
5781
          install_custom =
5782
            {
5783
               pre_command = [(OASISExpr.EBool true, None)];
5784
               post_command =
5785
                 [
5786
                    (OASISExpr.EBool true,
5787
                      Some
5788
                        (("mkdir",
5789
                           [
5790
                              "-p";
5791
                              "$(prefix)/include/lustrec;";
5792
                              "cp";
5793
                              "-rf";
5794
                              "include/*";
5795
                              "$(prefix)/include/lustrec"
5796
                           ])))
5797
                 ];
5798
               };
5799
          uninstall_custom =
5800
            {
5801
               pre_command = [(OASISExpr.EBool true, None)];
5802
               post_command = [(OASISExpr.EBool true, None)];
5803
               };
5804
          clean_custom =
5805
            {
5806
               pre_command = [(OASISExpr.EBool true, None)];
5807
               post_command = [(OASISExpr.EBool true, None)];
5808
               };
5809
          distclean_custom =
5810
            {
5811
               pre_command = [(OASISExpr.EBool true, None)];
5812
               post_command = [(OASISExpr.EBool true, None)];
5813
               };
5814
          files_ab = [];
5815
          sections =
5816
            [
5817
               Executable
5818
                 ({
5819
                     cs_name = "lustrec";
5820
                     cs_data = PropList.Data.create ();
5821
                     cs_plugin_data = [];
5822
                     },
5823
                   {
5824
                      bs_build = [(OASISExpr.EBool true, true)];
5825
                      bs_install = [(OASISExpr.EBool true, true)];
5826
                      bs_path = "src";
5827
                      bs_compiled_object = Native;
5828
                      bs_build_depends =
5829
                        [
5830
                           FindlibPackage ("ocamlgraph", None);
5831
                           FindlibPackage ("str", None);
5832
                           FindlibPackage ("unix", None)
5833
                        ];
5834
                      bs_build_tools = [ExternalTool "ocamlbuild"];
5835
                      bs_c_sources = [];
5836
                      bs_data_files = [];
5837
                      bs_ccopt = [(OASISExpr.EBool true, [])];
5838
                      bs_cclib = [(OASISExpr.EBool true, [])];
5839
                      bs_dlllib = [(OASISExpr.EBool true, [])];
5840
                      bs_dllpath = [(OASISExpr.EBool true, [])];
5841
                      bs_byteopt = [(OASISExpr.EBool true, [])];
5842
                      bs_nativeopt = [(OASISExpr.EBool true, [])];
5843
                      },
5844
                   {
5845
                      exec_custom = false;
5846
                      exec_main_is = "main_lustre_compiler.ml";
5847
                      });
5848
               Test
5849
                 ({
5850
                     cs_name = "nonregression";
5851
                     cs_data = PropList.Data.create ();
5852
                     cs_plugin_data = [];
5853
                     },
5854
                   {
5855
                      test_type = (`Test, "custom", None);
5856
                      test_command =
5857
                        [(OASISExpr.EBool true, ("make", ["test-compile"]))];
5858
                      test_custom =
5859
                        {
5860
                           pre_command = [(OASISExpr.EBool true, None)];
5861
                           post_command = [(OASISExpr.EBool true, None)];
5862
                           };
5863
                      test_working_directory = Some "test";
5864
                      test_run = [(OASISExpr.EBool true, true)];
5865
                      test_tools = [];
5866
                      })
5867
            ];
5868
          plugins = [(`Extra, "DevFiles", Some "0.2")];
5869
          schema_data = PropList.Data.create ();
5870
          plugin_data = [];
5871
          };
5872
     oasis_fn = Some "_oasis";
5873
     oasis_version = "0.3.0";
5874
     oasis_digest = Some "wX\249B\007\151\134\1970p\217\138\017\214\244\241";
5875
     oasis_exec = None;
5876
     oasis_setup_args = [];
5877
     setup_update = false;
5878<