Project

General

Profile

« Previous | Next » 

Revision 1ed1c8b8

Added by Guillaume DAVY almost 3 years ago

Ada: Corrections of some bugs discovered with lustrec-tests

View differences:

src/backends/Ada/ada_backend_common.ml
17 17
    underscore and must not contain a double underscore
18 18
   @param var name to be cleaned*)
19 19
let pp_clean_ada_identifier fmt name =
20
  let reserved_words = ["out"] in
20
  let reserved_words = ["abort"; "else"; "new"; "return";
21
                        "abs"; "elsif"; "not"; "reverse"; "abstract"; "end";
22
                        "null"; "accept"; "entry"; "select"; "access";
23
                        "exception"; "of"; "separate"; "aliased"; "exit";
24
                        "or"; "some"; "all"; "others"; "subtype"; "and";
25
                        "for"; "out"; "synchronized"; "array"; "function";
26
                        "overriding"; "at"; "tagged"; "generic"; "package";
27
                        "task"; "begin"; "goto"; "pragma"; "terminate";
28
                        "body"; "private"; "then"; "if"; "procedure"; "type";
29
                        "case"; "in"; "protected"; "constant"; "interface";
30
                        "until"; "is"; "raise"; "use"; "declare"; "	range";
31
                        "delay"; "limited"; "record"; "when"; "delta"; "loop";
32
                        "rem"; "while"; "digits"; "renames"; "with"; "do";
33
                        "mod"; "requeue"; "xor"] in
21 34
  let base_size = String.length name in
22 35
  assert(base_size > 0);
23 36
  let rec remove_double_underscore s = function
......
26 39
        remove_double_underscore (sprintf "%s%s" (String.sub s 0 i) (String.sub s (i+1) (String.length s-i-1))) i
27 40
    | i -> remove_double_underscore s (i+1)
28 41
  in
42
  let name = if String.get name (base_size-1) == '_' then name^"ada" else name in
29 43
  let name = remove_double_underscore name 0 in
30 44
  let prefix = if String.length name != base_size
31 45
                  || String.get name 0 == '_' 
32
                  || List.exists (String.equal name) reserved_words then
46
                  || List.exists (String.equal (String.lowercase_ascii name)) reserved_words then
33 47
                  "ada"
34 48
               else
35 49
                  ""
......
110 124
   @param fmt the formater to print on
111 125
**)
112 126
let pp_main_procedure_name fmt =
113
  fprintf fmt "main"
127
  fprintf fmt "ada_main"
114 128

  
115 129
(** Print a with statement to include a package.
116 130
   @param fmt the formater to print on
......
580 594
   **)
581 595
  let pp_ada_tag fmt t =
582 596
    pp_print_string fmt
583
      (if t = tag_true then "True" else if t = tag_false then "Flase" else t)
597
      (if t = tag_true then "True" else if t = tag_false then "False" else t)
584 598

  
585 599
  (** Printing function for machine type constants. For the moment,
586 600
      arrays are not supported.
......
661 675
    | "equi", [v1; v2] ->
662 676
      Format.fprintf fmt "((not %a) = (not %a))" pp_value v1 pp_value v2
663 677
    | "xor", [v1; v2]  ->
664
      Format.fprintf fmt "((not %a) \\= (not %a))" pp_value v1 pp_value v2
678
      Format.fprintf fmt "((not %a) /= (not %a))" pp_value v1 pp_value v2
665 679
    | "/", [v1; v2]    -> pp_div pp_value v1 v2 fmt
680
    | "&&", [v1; v2]    ->
681
      Format.fprintf fmt "(%a %s %a)" pp_value v1 "and then" pp_value v2
682
    | "||", [v1; v2]    ->
683
      Format.fprintf fmt "(%a %s %a)" pp_value v1 "or else" pp_value v2
684
    | "!=", [v1; v2]    ->
685
      Format.fprintf fmt "(%a %s %a)" pp_value v1 "/=" pp_value v2
666 686
    | op, [v1; v2]     ->
667 687
      Format.fprintf fmt "(%a %s %a)" pp_value v1 op pp_value v2
668 688
    | fun_name, _      ->

Also available in: Unified diff