From 663b942b97aa629489eb06b53ecb6682e9f5fbac Mon Sep 17 00:00:00 2001 From: Brian Drummond Date: Tue, 24 Dec 2013 16:54:03 +0000 Subject: Testsuite changes to elaborate and run tests marked run_compliant_test --- testsuite/get_entities.adb | 226 +++++++++++++++++++++ testsuite/gna/sr3028/testsuite.sh | 7 +- testsuite/testenv.sh | 1 + testsuite/vests/testsuite.sh | 33 ++- .../vhdl-93/clifton-labs/compliant/compliant.exp | 2 +- .../attributes/signal/simple-event-attribute.vhdl | 3 +- .../generics/entity-generic-defines-port-type.vhdl | 1 + .../block-statements/simple-grouping-block.vhdl | 2 +- 8 files changed, 258 insertions(+), 17 deletions(-) create mode 100644 testsuite/get_entities.adb (limited to 'testsuite') diff --git a/testsuite/get_entities.adb b/testsuite/get_entities.adb new file mode 100644 index 000000000..49021b78a --- /dev/null +++ b/testsuite/get_entities.adb @@ -0,0 +1,226 @@ +---------------------------------------------------------------------------- +-- get_entities (get_entities.adb) +-- +-- Copyright (C) 2013, Brian Drummond +-- +-- This file is part of the ghdl-updates project. +-- +-- get_entities is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 2 of the License, or +-- (at your option) any later version. +-- +-- get_entities is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with get_entities. If not, see . +---------------------------------------------------------------------------- + + +with Ada.Text_Io; +with Ada.Characters.Handling; +with Ada.Strings.Fixed; +with Ada.Strings.Maps; +with Ada.Strings.Unbounded; +with Ada.Directories; +with Ada.Command_Line; + +procedure get_entities is + + function Valid_Test(Name : in String) return boolean is + use Ada.Directories; + use Ada.Characters.Handling; + begin + return Extension(To_Lower(Name)) = "vhd" or Extension(To_Lower(Name)) = "vhdl"; + end Valid_Test; + + procedure Get_Top_Entities(Test_Name : in String) is + use Ada.Text_Io; + use Ada.Strings.Fixed; + use Ada.Characters.Handling; + use Ada.Strings.Unbounded; + + File : File_Type; + + function Get_End(Line : in String) return Natural is + Comment : natural := Index(Line,"--"); + begin + if Comment = 0 then + return Line'last; + else + return Comment - 1; + end if; + end Get_End; + + type State_Type is (Idle, Have_Entity, Have_Name, In_Entity, Have_End); + State : State_Type; + + Top_Level_Entity : Boolean; + Name : Unbounded_String; + + begin + -- Return the name of all top-level entities in the file. + -- Report on stderr, a malformed one + -- "malformed" means not conforming to the expectations of this simple parser. + -- A top level entity has the form + -- Entity is + -- + -- end {entity} + + Open(File, In_File, Test_Name); + State := Idle; + loop + declare + -- strip name of blanks etc... + CharSet : constant Ada.Strings.Maps.Character_Ranges := (('A','Z'), ('a','z'), ('0','9'), ('_','_')); + + function Token(Source, Name : String; From : positive := 1) return natural is + use Ada.Strings.Maps; + Pos : natural := Index(Source, Name, From => From); + begin + -- Look in Source for Name, either surrounded by whitespace or at the start or end of a line + if Pos = 0 or Pos = 1 or Pos + Name'Length > Source'Length then + return Pos; + elsif not is_in (Source(Pos - 1), To_Set(CharSet)) and + not is_in (Source(Pos + Name'Length), To_Set(CharSet)) then + return Pos; + else + return 0; + end if; + end Token; + + function Strip_Quoted(Raw : String) return String is + temp : String(Raw'range); + t : natural := Raw'first; + copy : Boolean := true; + begin + -- Eliminate quoted text + for i in Raw'range loop + if copy then + if Raw(i) = '"' then + copy := not copy; + else + temp(t) := Raw(i); + t := t + 1; + end if; + else + if Raw(i) = '"' then + copy := not copy; + end if; + end if; + end loop; + if t > Raw'last then t := Raw'last; end if; + return temp(Raw'first .. t); + end Strip_Quoted; + + Line : String := Get_Line (File); -- line based to strip off comments + EndLine : natural := Get_End (Line); + Raw : String := To_Lower(Line (1 .. EndLine)); + Code : String := Strip_Quoted(Raw); + -- positions of specific strings in a line. + Ent : Natural := Token(Code, "entity"); + Port : Natural := Token(Code, "port"); + End_Pos : Natural := Token(Code, "end"); + I : Natural; -- position of "is" in current line + Name_s : Natural; -- start of a possible entity name + Name_e : Natural; -- end of a possible entity name + Name_n : Natural; -- start of next name (should be "is") + Dot : Natural; -- position of "." indicating qualified name, e.g. entity instantiation + + procedure Get_Name is + begin + Name_e := Index(Code, Ada.Strings.Maps.To_Set(CharSet), + Test => Ada.Strings.Outside, From => Name_s); + if Name_e = 0 then Name_e := Code'last; end if; + --Put_Line("Name : " & To_S(Name) & " " + -- & natural'image(Name_s) & " " & natural'image(Name_e) + -- & natural'image(Code'last)); + if Name_e < Code'last then + Name_n := Index(Code, Ada.Strings.Maps.To_Set(CharSet), From => Name_e); + else + Name_n := 0; + end if; + I := Token(Code, "is", From => Name_e); + Dot := Index(Code, ".", From => Name_e); + + if Name_e < Name_s then + Put_Line(Standard_Error, "Malformed name : " & Code); + end if; + Name := To_Unbounded_String (Code (Name_s .. Name_e-1)); + if I = 0 then -- "is" must be on a subsequent line + State := Have_Name; + elsif Name_n = I then -- next word is "is" + State := In_Entity; + elsif Dot < Name_n and Dot >= Name_e then + -- direct instantiation ... reject + State := Idle; + elsif Name_n < I then + Put_Line(Standard_Error, "Name error : file " & Test_Name); + Put_Line(Standard_Error, "Entity : """ & Code(Name_s .. I-1) & """ not valid"); + -- raise Program_Error; + end if; + end Get_Name; + + begin + case State is + when Idle => + if Ent /= 0 then + -- Put_Line(Code); + Top_Level_Entity := True; + Name_s := Index(Code, Ada.Strings.Maps.To_Set(CharSet), From => Ent + 6); + + if Name_s = 0 then -- entity name must be on a subsequent line + State := Have_Entity; + else + Get_Name; + end if; + end if; + when Have_Entity => + Name_s := Index(Code, Ada.Strings.Maps.To_Set(CharSet), From => Ent + 6); + if Name_s > 0 then + Get_Name; + end if; + when Have_Name => + if I > 0 then + State := In_Entity; + end if; + when In_Entity => -- wait for End, handle Port; + -- NB the End may not be End Entity, but whatever it Ends, it must follow the port list + -- so we may stop looking for a port list when we see it. + if Port > 0 then + Top_Level_Entity := False; + end if; + if End_Pos > 0 then + State := Have_End; + end if; + when Have_End => + if Top_Level_Entity then -- write name to stdout + Put(To_String(Name) & " "); + end if; + State := Idle; + end Case; + exit when End_Of_File (File); + end; + end loop; + + New_Line; + Close(File); + + end Get_Top_Entities; + + procedure Usage is + begin + Ada.Text_Io.Put_Line(Ada.Text_Io.Standard_Error, "Usage : " & Ada.Command_Line.Command_Name & " "); + end Usage; + +begin + if Ada.Command_Line.Argument_Count = 0 then + raise Program_Error; + end if; + Get_Top_Entities(Ada.Command_Line.Argument(1)); +exception + when Program_Error => Usage; +end get_entities; diff --git a/testsuite/gna/sr3028/testsuite.sh b/testsuite/gna/sr3028/testsuite.sh index e63a031d0..95ec1c6da 100755 --- a/testsuite/gna/sr3028/testsuite.sh +++ b/testsuite/gna/sr3028/testsuite.sh @@ -2,12 +2,7 @@ . ../../testenv.sh -echo "Skipped !!!!" -exit 0 - -analyze vc.vhdl -analyze top.vhdl -elab_simulate_failure top +analyze_failure vc.vhdl clean diff --git a/testsuite/testenv.sh b/testsuite/testenv.sh index 9283fa058..ef8f86250 100644 --- a/testsuite/testenv.sh +++ b/testsuite/testenv.sh @@ -16,6 +16,7 @@ #GHDL=ghdl RM=rm LN=ln +GET_ENTITIES=../get_entities # Exit in case of failure in shell scripts. set -e diff --git a/testsuite/vests/testsuite.sh b/testsuite/vests/testsuite.sh index 884944c51..fd82b7b3b 100755 --- a/testsuite/vests/testsuite.sh +++ b/testsuite/vests/testsuite.sh @@ -72,6 +72,17 @@ handle_test () ;; run) eval $cmd + ent=`$GET_ENTITIES $dir/$file` + if [ x$ent = "x" ]; then + echo "Cannot elaborate or run : no top level entity"; + else + cmd="$GHDL -e $ent"; + echo "$cmd"; + eval $cmd; + cmd="$GHDL -r $ent --assert-level=error"; + echo "$cmd"; + eval $cmd; + fi ;; ana_err) if eval $cmd; then @@ -81,14 +92,20 @@ handle_test () ;; run_err) eval $cmd - ent=`sed -n -e "/^ENTITY \([a-zA-Z0-9]*\) IS$/p" < $dir/$file \ - | cut -f 2 -d ' '` - cmd="$GHDL -e $ent" - echo "$cmd" - eval $cmd - cmd="$GHDL -r $ent --expect-failure --assert-level=error" - echo "$cmd" - eval $cmd +# ent=`sed -n -e "/^ENTITY \([a-zA-Z0-9]*\) IS$/p" < $dir/$file \ +# | cut -f 2 -d ' '` + ent=`$GET_ENTITIES $dir/$file` + if [ x$ent = "x" ]; then + echo "Cannot elaborate or run : no top level entity"; + exit 1; + else + cmd="$GHDL -e $ent"; + echo "$cmd"; + eval $cmd; + cmd="$GHDL -r $ent --expect-failure --assert-level=error"; + echo "$cmd"; + eval $cmd; + fi ;; *) echo "Unknown mode '$mode'"; diff --git a/testsuite/vests/vhdl-93/clifton-labs/compliant/compliant.exp b/testsuite/vests/vhdl-93/clifton-labs/compliant/compliant.exp index ba835c148..46223f18d 100644 --- a/testsuite/vests/vhdl-93/clifton-labs/compliant/compliant.exp +++ b/testsuite/vests/vhdl-93/clifton-labs/compliant/compliant.exp @@ -43,7 +43,7 @@ foreach local_test_name [find ${subdir} *\.vhd*] { set output_file_name [lindex ${output_file_name} [expr [llength ${output_file_name}] - 1]] # set output_files_argument "INPUT=${output_file_name}:[pwd]/${output_files}" set output_files_argument "INPUT=${output_file_name}:${output_files}" - verbose "Ouput files glob: ${output_files_glob}, files found: ${output_files}, argument generated ${output_files_argument}" 2 + verbose "Output files glob: ${output_files_glob}, files found: ${output_files}, argument generated ${output_files_argument}" 2 } verbose "Running test at ./[string range ${local_test_name} [expr ${dir_prefix_length} - 2] end] ${input_files_argument} ${output_files_argument}" 2 diff --git a/testsuite/vests/vhdl-93/clifton-labs/compliant/functional/attributes/signal/simple-event-attribute.vhdl b/testsuite/vests/vhdl-93/clifton-labs/compliant/functional/attributes/signal/simple-event-attribute.vhdl index e3c5d30cb..e37fe34a1 100644 --- a/testsuite/vests/vhdl-93/clifton-labs/compliant/functional/attributes/signal/simple-event-attribute.vhdl +++ b/testsuite/vests/vhdl-93/clifton-labs/compliant/functional/attributes/signal/simple-event-attribute.vhdl @@ -13,7 +13,8 @@ begin -- s <= '1'; -- wait for 0 ns; assert s = '0' report "TEST FAILED - s has not changed to 0 yet!" severity failure; - wait for 10 ns; + --wait for 10 ns; + wait for 4 ns; assert s = '1' report "TEST FAILED - s has not changed to 1 yet!" severity failure; assert (s'event) report "TEST FAILED - 'event not tripped" severity failure; report "TEST PASSED"; diff --git a/testsuite/vests/vhdl-93/clifton-labs/compliant/functional/generics/entity-generic-defines-port-type.vhdl b/testsuite/vests/vhdl-93/clifton-labs/compliant/functional/generics/entity-generic-defines-port-type.vhdl index 2257c1204..d77743afc 100644 --- a/testsuite/vests/vhdl-93/clifton-labs/compliant/functional/generics/entity-generic-defines-port-type.vhdl +++ b/testsuite/vests/vhdl-93/clifton-labs/compliant/functional/generics/entity-generic-defines-port-type.vhdl @@ -35,6 +35,7 @@ begin -- only gdpt1_finished <= true; wait for 1 fs; report "TEST PASSED"; + wait; end process doit; end only; diff --git a/testsuite/vests/vhdl-93/clifton-labs/compliant/functional/statements/block-statements/simple-grouping-block.vhdl b/testsuite/vests/vhdl-93/clifton-labs/compliant/functional/statements/block-statements/simple-grouping-block.vhdl index c10bd2211..0223d6d94 100644 --- a/testsuite/vests/vhdl-93/clifton-labs/compliant/functional/statements/block-statements/simple-grouping-block.vhdl +++ b/testsuite/vests/vhdl-93/clifton-labs/compliant/functional/statements/block-statements/simple-grouping-block.vhdl @@ -20,7 +20,7 @@ begin -- only begin if delay_line_out = '1' then assert now = 1 ns report "TEST FAILED - delay did not happen as expected!" severity FAILURE; - assert not(now = 1 ns) report "TEST PASSED" severity FAILURE; + assert not(now = 1 ns) report "TEST PASSED" severity WARNING; end if; end process; end only; -- cgit v1.2.3