diff options
author | Pascal Rigaux <pixel@mandriva.com> | 2003-05-26 11:04:02 +0000 |
---|---|---|
committer | Pascal Rigaux <pixel@mandriva.com> | 2003-05-26 11:04:02 +0000 |
commit | 71e22a18b8733c7fb0aab0f2a82172e742afdaa4 (patch) | |
tree | 0e2709068047d78b0cf39e5b683293c98b1bdf31 /perl_checker.src | |
parent | 84aca39a394a9e5df15e342ebc4989d616c7ca6a (diff) | |
download | perl_checker-71e22a18b8733c7fb0aab0f2a82172e742afdaa4.tar perl_checker-71e22a18b8733c7fb0aab0f2a82172e742afdaa4.tar.gz perl_checker-71e22a18b8733c7fb0aab0f2a82172e742afdaa4.tar.bz2 perl_checker-71e22a18b8733c7fb0aab0f2a82172e742afdaa4.tar.xz perl_checker-71e22a18b8733c7fb0aab0f2a82172e742afdaa4.zip |
check prototype coherence: disallow ($a, @b, $c) or ($a, $o_b, $c)
Diffstat (limited to 'perl_checker.src')
-rw-r--r-- | perl_checker.src/tree.ml | 11 |
1 files changed, 9 insertions, 2 deletions
diff --git a/perl_checker.src/tree.ml b/perl_checker.src/tree.ml index 9b62bb9..f866e14 100644 --- a/perl_checker.src/tree.ml +++ b/perl_checker.src/tree.ml @@ -258,9 +258,16 @@ let has_proto perl_proto body = | _ -> None let get_proto perl_proto body = - map_option (fun (mys, _pos, _) -> + map_option (fun (mys, pos, _) -> let scalars, others = break_at (fun (context, _) -> context <> I_scalar) mys in - let must_have, optional = break_at (fun (_, s) -> String.length s > 2 && (s.[0] = 'o' || s.[0] = 'b') && s.[1] = '_') scalars in + (match others with + | (I_array, _) :: _ :: _ -> warn_with_pos pos "an array must be the last variable in a prototype" + | (I_hash, _) :: _ :: _ -> warn_with_pos pos "an hash must be the last variable in a prototype" + | _ -> ()); + let is_optional (_, s) = String.length s > 2 && (s.[0] = 'o' || s.[0] = 'b') && s.[1] = '_' in + let must_have, optional = break_at is_optional scalars in + if not (List.for_all is_optional optional) then + warn_with_pos pos "an non-optional argument must not follow an optional argument"; let min = List.length must_have in { proto_nb_min = min; proto_nb_max = if others = [] then Some(min + List.length optional) else None } ) (has_proto perl_proto body) |