From ba44667f0f9585e694cf70eebe5010ae9dc10b76 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Wed, 3 Aug 2011 12:29:09 +0200 Subject: [PATCH] Add support for checking if/then layout. Add corresponding test. --- regtests/makefile | 2 ++ regtests/out21.out | 1 + regtests/thenlayout.adb | 24 ++++++++++++++ src/checks.ads | 4 +++ src/languages.adb | 28 ++++++++++++++++ src/languages.ads | 8 +++++ src/style_checker.adb | 88 ++++++++++++++++++++++++++++++++++++++++++++++++- 7 files changed, 154 insertions(+), 1 deletion(-) create mode 100644 regtests/out21.out create mode 100644 regtests/thenlayout.adb diff --git a/regtests/makefile b/regtests/makefile index 18425ff..40d6658 100644 --- a/regtests/makefile +++ b/regtests/makefile @@ -37,6 +37,7 @@ run_tests: -../style_checker -HA withtab.adb >> out18.res 2>&1 -../style_checker -C makefile > out19.res 2>&1 -../style_checker -Ho operator.adb > out20.res 2>&1 + -../style_checker -Hi thenlayout.adb > out21.res 2>&1 check_results: echo "### regressions follows" @@ -61,6 +62,7 @@ check_results: -diff -wc out18.out out18.res || echo $$? >> out_status.res -diff -wc out19.out out19.res || echo $$? >> out_status.res -diff -wc out20.out out20.res || echo $$? >> out_status.res + -diff -wc out21.out out21.res || echo $$? >> out_status.res test ! -e out_status.res clean: diff --git a/regtests/out21.out b/regtests/out21.out new file mode 100644 index 0000000..c7fbc17 --- /dev/null +++ b/regtests/out21.out @@ -0,0 +1 @@ +thenlayout.adb:15: 'then' incorrect layout diff --git a/regtests/thenlayout.adb b/regtests/thenlayout.adb new file mode 100644 index 0000000..f2bee88 --- /dev/null +++ b/regtests/thenlayout.adb @@ -0,0 +1,24 @@ +procedure ThenLayout is + Toto : Natural := 9; +begin + if Toto = 8 then + null; + end if; + + if Toto = 8 + or else Toto = 12 + then + null; + end if; + + if Toto = 2 + and then Toto = 12 then + null; + end if; + + if Gh = 12 then + null; + elsif Gh = 9 then + null; + end if; +end ThenLayout; diff --git a/src/checks.ads b/src/checks.ads index 96fc26d..da90e6b 100644 --- a/src/checks.ads +++ b/src/checks.ads @@ -82,6 +82,10 @@ package Checks is Operator_EOL : Mode := Accepted; -- Check for operators at end of line + + Then_Layout : Mode := Accepted; + -- Check for Then layout (Ada), should be on the line with the if or the + -- first word on its line. end record; end Checks; diff --git a/src/languages.adb b/src/languages.adb index e2cc31a..50a3199 100644 --- a/src/languages.adb +++ b/src/languages.adb @@ -240,6 +240,15 @@ package body Languages is return L.C.Tabulation; end Get_Tabulation; + --------------------- + -- Get_Then_Layout -- + --------------------- + + function Get_Then_Layout (L : in Lang) return Checks.Mode is + begin + return L.C.Then_Layout; + end Get_Then_Layout; + ------------------------- -- Get_Trailing_Spaces -- ------------------------- @@ -523,6 +532,25 @@ package body Languages is end if; end Set_Tabulation; + --------------------- + -- Set_Then_Layout -- + --------------------- + + procedure Set_Then_Layout + (L : in Lang_Access; + Mode : in Checks.Mode) + is + begin + if L = null then + for K in 1 .. Index loop + Set_Then_Layout (Lang_Set (K), Mode); + end loop; + + else + L.C.Then_Layout := Mode; + end if; + end Set_Then_Layout; + ------------------------- -- Set_Trailing_Spaces -- ------------------------- diff --git a/src/languages.ads b/src/languages.ads index ce3825f..c7a5d8a 100644 --- a/src/languages.ads +++ b/src/languages.ads @@ -178,6 +178,14 @@ package Languages is function Get_Operator_EOL (L : in Lang) return Checks.Mode; + -- Then layout + + procedure Set_Then_Layout + (L : in Lang_Access; + Mode : in Checks.Mode); + + function Get_Then_Layout (L : in Lang) return Checks.Mode; + private type Lang is tagged record diff --git a/src/style_checker.adb b/src/style_checker.adb index cd69f6c..2e6cea8 100644 --- a/src/style_checker.adb +++ b/src/style_checker.adb @@ -39,6 +39,7 @@ -- with Ada.Calendar; +with Ada.Characters.Handling; with Ada.Command_Line; with Ada.Containers.Indefinite_Hashed_Sets; with Ada.Directories; @@ -230,6 +231,8 @@ procedure Style_Checker is procedure Check_Operator_EOL; + procedure Check_Then_Layout; + --------------------------- -- Check_Comment_Dot_EOL -- --------------------------- @@ -545,6 +548,83 @@ procedure Style_Checker is end if; end Check_Tab; + ----------------------- + -- Check_Then_Layout -- + ----------------------- + + procedure Check_Then_Layout is + + function Is_Word (First, Last : Natural) return Boolean; + -- Returns True if Str is a word and not a substring + + ------------- + -- Is_Word -- + ------------- + + function Is_Word (First, Last : Natural) return Boolean is + use Ada.Characters.Handling; + begin + if (First > Line'First + and then Is_Alphanumeric (Line (First - 1))) + or else + (Last < Line'Last and then Is_Alphanumeric (Line (Last + 1))) + then + return False; + else + return True; + end if; + end Is_Word; + + I : constant Natural := Fixed.Index_Non_Blank (Line); + L : Natural := Line'Length; + If_Pos, Then_Pos : Natural; + begin + if Checker.Lang.Get_Then_Layout = Checks.Rejected and then I /= 0 then + if Checker.Lang.Comment /= "" + and then Fixed.Index (Line, String'(Checker.Lang.Comment)) /= 0 + then + L := Fixed.Index (Line, String'(Checker.Lang.Comment)); + end if; + + If_Pos := Fixed.Index (Line (I .. L), "if"); + Then_Pos := + Fixed.Index (Line (I .. L), "then", Going => Strings.Backward); + + if If_Pos /= 0 and then not Is_Word (If_Pos, If_Pos + 1) then + -- This is not an if keyword + If_Pos := 0; + end if; + + -- If no If found, check for an elsif + + if If_Pos = 0 then + If_Pos := Fixed.Index (Line (I .. L), "elsif"); + + if If_Pos /= 0 and then not Is_Word (If_Pos, If_Pos + 4) then + -- This is not an if keyword + If_Pos := 0; + end if; + end if; + + if Then_Pos /= 0 + and then + (not Is_Word (Then_Pos, Then_Pos + 3) + or else (Then_Pos - 4 >= 1 and then Then_Pos + 3 <= L + and then + Line (Then_Pos - 4 .. Then_Pos + 3) = "and then")) + then + -- This is not a then keyword + Then_Pos := 0; + end if; + + if Then_Pos /= 0 and then If_Pos = 0 and then Then_Pos /= I then + -- then keyword not on the line with the if and it is not the + -- first word on this line. + Report_Error (Checker.File, "'then' incorrect layout"); + end if; + end if; + end Check_Then_Layout; + --------------------------- -- Check_Trailing_Spaces -- --------------------------- @@ -571,6 +651,7 @@ procedure Style_Checker is Check_Comment_Dot_EOL; Check_Tab; Check_Operator_EOL; + Check_Then_Layout; end Check_Line; -------------------- @@ -688,6 +769,7 @@ procedure Style_Checker is P (" -E : disable line ending check"); P (" -h N : start with an header of N line (default N 20)"); P (" -H : disable header check"); + P (" -i : enable if/then layout"); P (" -l N : line length <= N (default 79)"); P (" -L : disable line length check"); P (" -m N : output only the first N errors"); @@ -722,7 +804,7 @@ begin else loop case GNAT.Command_Line.Getopt - ("a A abs lang: ign: e: E l? h? H " + ("a A abs lang: ign: e: E l? h? H i " & "L b B s S t T v c? C cp cy cP cY cf: cF d D sp: m: n: o") is when ASCII.NUL => @@ -762,6 +844,10 @@ begin begin if Full = "ign" then Ignore_Set.Include (GNAT.Command_Line.Parameter); + + elsif Full = "i" then + Languages.Set_Then_Layout (Lang, Checks.Rejected); + else raise Checks.Syntax_Error; end if; -- 2.11.4.GIT