diff options
| author | Tristan Gingold <tgingold@free.fr> | 2020-12-26 14:26:59 +0100 | 
|---|---|---|
| committer | Tristan Gingold <tgingold@free.fr> | 2020-12-26 17:35:10 +0100 | 
| commit | b9788c0bb2fabdcdd70029cd2ffbdd12706aea1d (patch) | |
| tree | eb903a286fca01f9c039f6c69a92e1399a90c84e /src | |
| parent | f60887e70ac8f2b24637b4710f5cb9a18acef6aa (diff) | |
| download | ghdl-b9788c0bb2fabdcdd70029cd2ffbdd12706aea1d.tar.gz ghdl-b9788c0bb2fabdcdd70029cd2ffbdd12706aea1d.tar.bz2 ghdl-b9788c0bb2fabdcdd70029cd2ffbdd12706aea1d.zip | |
libraries: Load_Std_Library: now return a status.
Propagate this change to libghdl and python binding to avoid abort.
For #1551
Diffstat (limited to 'src')
| -rw-r--r-- | src/ghdldrv/ghdlcomp.adb | 19 | ||||
| -rw-r--r-- | src/ghdldrv/ghdldrv.adb | 8 | ||||
| -rw-r--r-- | src/ghdldrv/ghdllocal.adb | 51 | ||||
| -rw-r--r-- | src/ghdldrv/ghdllocal.ads | 3 | ||||
| -rw-r--r-- | src/ghdldrv/ghdlprint.adb | 17 | ||||
| -rw-r--r-- | src/ghdldrv/ghdlxml.adb | 4 | ||||
| -rw-r--r-- | src/libraries.adb | 11 | ||||
| -rw-r--r-- | src/libraries.ads | 3 | ||||
| -rw-r--r-- | src/vhdl/libghdl/libghdl.adb | 33 | ||||
| -rw-r--r-- | src/vhdl/libghdl/libghdl.ads | 3 | ||||
| -rw-r--r-- | src/vhdl/translate/ortho_front.adb | 4 | 
11 files changed, 117 insertions, 39 deletions
| diff --git a/src/ghdldrv/ghdlcomp.adb b/src/ghdldrv/ghdlcomp.adb index 3a91136ce..47f530e1b 100644 --- a/src/ghdldrv/ghdlcomp.adb +++ b/src/ghdldrv/ghdlcomp.adb @@ -307,10 +307,15 @@ package body Ghdlcomp is     procedure Common_Compile_Init (Analyze_Only : Boolean) is     begin        if Analyze_Only then -         Setup_Libraries (True); +         if not Setup_Libraries (True) then +            raise Option_Error; +         end if;        else -         Setup_Libraries (False); -         Libraries.Load_Std_Library; +         if not Setup_Libraries (False) +           or else not Libraries.Load_Std_Library +         then +            raise Option_Error; +         end if;           --  WORK library is not loaded.  FIXME: why ?        end if; @@ -739,7 +744,9 @@ package body Ghdlcomp is        Lib : Iir_Library_Declaration;     begin        Extract_Elab_Unit ("-m", Args, Next_Arg, Prim_Id, Sec_Id); -      Setup_Libraries (True); +      if not Setup_Libraries (True) then +         return; +      end if;        --  Create list of files.        Files_List := Build_Dependence (Prim_Id, Sec_Id); @@ -881,7 +888,9 @@ package body Ghdlcomp is        Next_Arg : Natural;     begin        Extract_Elab_Unit ("--gen-makefile", Args, Next_Arg, Prim_Id, Sec_Id); -      Setup_Libraries (True); +      if not Setup_Libraries (True) then +         return; +      end if;        Files_List := Build_Dependence (Prim_Id, Sec_Id);        Ghdllocal.Gen_Makefile_Disp_Header; diff --git a/src/ghdldrv/ghdldrv.adb b/src/ghdldrv/ghdldrv.adb index 648ef9a0e..8d99beca5 100644 --- a/src/ghdldrv/ghdldrv.adb +++ b/src/ghdldrv/ghdldrv.adb @@ -584,7 +584,9 @@ package body Ghdldrv is        use Libraries;     begin        Set_Tools_Name (Cmd); -      Setup_Libraries (Load); +      if not Setup_Libraries (Load) then +         raise Option_Error; +      end if;        Locate_Tools (Cmd);        for I in 2 .. Get_Nbr_Paths loop           Add_Argument (Cmd.Compiler_Args, @@ -1882,7 +1884,9 @@ package body Ghdldrv is           Set_Elab_Units (Cmd, "--gen-makefile", Args);        end if; -      Setup_Libraries (True); +      if not Setup_Libraries (True) then +         raise Option_Error; +      end if;        Files_List := Build_Dependence (Primary_Id, Secondary_Id);        Ghdllocal.Gen_Makefile_Disp_Header; diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb index 8570144ee..14756b29c 100644 --- a/src/ghdldrv/ghdllocal.adb +++ b/src/ghdldrv/ghdllocal.adb @@ -399,7 +399,7 @@ package body Ghdllocal is        Libraries.Add_Library_Path (Path);     end Add_Library_Name; -   procedure Setup_Libraries (Load : Boolean) +   function Setup_Libraries (Load : Boolean) return Boolean     is        use Flags;     begin @@ -462,9 +462,12 @@ package body Ghdllocal is             (Get_Machine_Path_Prefix & Directory_Separator);        end if;        if Load then -         Libraries.Load_Std_Library; +         if not Libraries.Load_Std_Library then +            return False; +         end if;           Libraries.Load_Work_Library;        end if; +      return True;     end Setup_Libraries;     procedure Disp_Config_Prefixes is @@ -476,7 +479,9 @@ package body Ghdllocal is           Put_Line (Switch_Prefix_Path.all);        end if; -      Setup_Libraries (False); +      if not Setup_Libraries (False) then +         Put_Line ("(error while loading libraries)"); +      end if;        Put ("environment prefix (GHDL_PREFIX): ");        if Prefix_Env = null then @@ -637,7 +642,9 @@ package body Ghdllocal is     is        pragma Unreferenced (Cmd);     begin -      Setup_Libraries (True); +      if not Setup_Libraries (True) then +         return; +      end if;        if Args'Length = 0 then           Disp_Library (Std_Names.Name_Work); @@ -701,7 +708,9 @@ package body Ghdllocal is        Flag_Add : constant Boolean := False;     begin        Flags.Bootstrap := True; -      Libraries.Load_Std_Library; +      if not Libraries.Load_Std_Library then +         raise Option_Error; +      end if;        Libraries.Load_Work_Library;        for I in Args'Range loop @@ -765,7 +774,9 @@ package body Ghdllocal is        Next_Unit : Iir;        Lib : Iir;     begin -      Setup_Libraries (True); +      if not Setup_Libraries (True) then +         return; +      end if;        --  Parse all files.        for I in Args'Range loop @@ -916,7 +927,10 @@ package body Ghdllocal is     is        Error_1 : Boolean;     begin -      Setup_Libraries (True); +      if not Setup_Libraries (True) then +         Error := True; +         return; +      end if;        --  Parse all files.        Error := False; @@ -1015,7 +1029,9 @@ package body Ghdllocal is        Flags.Bootstrap := True;        --  Load libraries. -      Libraries.Load_Std_Library; +      if not Libraries.Load_Std_Library then +         raise Option_Error; +      end if;        Libraries.Load_Work_Library;        File := Get_Design_File_Chain (Libraries.Work_Library); @@ -1123,8 +1139,11 @@ package body Ghdllocal is           raise Option_Error;        end if; -      Setup_Libraries (False); -      Libraries.Load_Std_Library; +      if not Setup_Libraries (False) +        or else not Libraries.Load_Std_Library +      then +         return; +      end if;        Dir := Work_Directory;        Work_Directory := Null_Identifier;        Libraries.Load_Work_Library; @@ -1200,7 +1219,9 @@ package body Ghdllocal is           raise Option_Error;        end if;        Flags.Bootstrap := True; -      Libraries.Load_Std_Library; +      if not Libraries.Load_Std_Library then +         raise Option_Error; +      end if;        Vhdl.Prints.Disp_Vhdl (Vhdl.Std_Package.Std_Standard_Unit);     end Perform_Action; @@ -1238,7 +1259,9 @@ package body Ghdllocal is        From : Iir;        Top : Iir;     begin -      Setup_Libraries (True); +      if not Setup_Libraries (True) then +         return; +      end if;        if Args'Length = 0 then           From := Work_Library; @@ -1813,7 +1836,9 @@ package body Ghdllocal is        Next_Arg : Natural;     begin        Extract_Elab_Unit ("--elab-order", Args, Next_Arg, Prim_Id, Sec_Id); -      Setup_Libraries (True); +      if not Setup_Libraries (True) then +         return; +      end if;        Files_List := Build_Dependence (Prim_Id, Sec_Id);        Files_It := List_Iterate (Files_List); diff --git a/src/ghdldrv/ghdllocal.ads b/src/ghdldrv/ghdllocal.ads index 0b195dee5..ee990f1d9 100644 --- a/src/ghdldrv/ghdllocal.ads +++ b/src/ghdldrv/ghdllocal.ads @@ -116,7 +116,8 @@ package Ghdllocal is     procedure Disp_Config_Prefixes;     --  Setup standard libaries path.  If LOAD is true, then load them now. -   procedure Setup_Libraries (Load : Boolean); +   --  Return TRUE in case of success, FALSE in case of failure. +   function Setup_Libraries (Load : Boolean) return Boolean;     --  Set Exec_Prefix from program name.  Called by Setup_Libraries.     procedure Set_Exec_Prefix_From_Program_Name; diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb index 2ddc74e75..79d20c68d 100644 --- a/src/ghdldrv/ghdlprint.adb +++ b/src/ghdldrv/ghdlprint.adb @@ -692,7 +692,9 @@ package body Ghdlprint is        Flags.Bootstrap := True;        Flags.Flag_Elocations := True;        --  Load word library. -      Libraries.Load_Std_Library; +      if not Libraries.Load_Std_Library then +         raise Option_Error; +      end if;        Libraries.Load_Work_Library;        --  First loop: parse source file, check destination file does not @@ -1066,7 +1068,10 @@ package body Ghdlprint is        Id : Name_Id;     begin        if Cmd.Flag_Sem then -         Setup_Libraries (True); +         -- Libraries are required for semantic analysis. +         if not Setup_Libraries (True) then +            return; +         end if;        end if;        --  Keep parenthesis during parse. @@ -1437,7 +1442,9 @@ package body Ghdlprint is        Flags.Flag_Xref := True;        --  Load work library. -      Setup_Libraries (True); +      if not Setup_Libraries (True) then +         return; +      end if;        Output_Dir := Cmd.Output_Dir;        if Output_Dir = null then @@ -1690,7 +1697,9 @@ package body Ghdlprint is        Files : File_Data_Array;     begin        --  Load work library. -      Setup_Libraries (True); +      if not Setup_Libraries (True) then +         return; +      end if;        Vhdl.Xrefs.Init;        Flags.Flag_Xref := True; diff --git a/src/ghdldrv/ghdlxml.adb b/src/ghdldrv/ghdlxml.adb index 15a8a2940..59de6f386 100644 --- a/src/ghdldrv/ghdlxml.adb +++ b/src/ghdldrv/ghdlxml.adb @@ -555,7 +555,9 @@ package body Ghdlxml is        Files : File_Data_Array;     begin        --  Load work library. -      Setup_Libraries (True); +      if not Setup_Libraries (True) then +         return; +      end if;        --  Parse all files.        for I in Files'Range loop diff --git a/src/libraries.adb b/src/libraries.adb index d7ff72a85..42228ea6c 100644 --- a/src/libraries.adb +++ b/src/libraries.adb @@ -630,15 +630,13 @@ package body Libraries is     end Load_Library;     -- Note: the scanner shouldn't be in use, since this procedure uses it. -   procedure Load_Std_Library (Build_Standard : Boolean := True) +   function Load_Std_Library (Build_Standard : Boolean := True) return Boolean     is        use Vhdl.Std_Package;        Dir : Name_Id;     begin -      if Libraries_Chain /= Null_Iir then -         --  This procedure must not be called twice. -         raise Internal_Error; -      end if; +      --  This procedure must not be called twice. +      pragma Assert (Libraries_Chain = Null_Iir);        Flags.Create_Flag_String; @@ -668,7 +666,7 @@ package body Libraries is          and then not Flags.Bootstrap        then           Error_Msg_Option ("cannot find ""std"" library"); -         raise Option_Error; +         return False;        end if;        if Build_Standard then @@ -682,6 +680,7 @@ package body Libraries is        end if;        Set_Visible_Flag (Std_Library, True); +      return True;     end Load_Std_Library;     procedure Load_Work_Library (Empty : Boolean := False) diff --git a/src/libraries.ads b/src/libraries.ads index 66a80a747..8e9967ff1 100644 --- a/src/libraries.ads +++ b/src/libraries.ads @@ -94,7 +94,8 @@ package Libraries is     --  Initialize the library manager and load the STD library.     --  If BUILD_STANDARD is false, the std.standard library is not created. -   procedure Load_Std_Library (Build_Standard : Boolean := True); +   --  Return TRUE in case of success, FALSE in case of failure. +   function Load_Std_Library (Build_Standard : Boolean := True) return Boolean;     -- Save the work library as a host-dependent library.     procedure Save_Work_Library; diff --git a/src/vhdl/libghdl/libghdl.adb b/src/vhdl/libghdl/libghdl.adb index 67de461cf..bd6d83c5a 100644 --- a/src/vhdl/libghdl/libghdl.adb +++ b/src/vhdl/libghdl/libghdl.adb @@ -39,13 +39,24 @@ package body Libghdl is        end if;     end Set_Option; -   procedure Compile_Init (Analyze_Only : Boolean) is +   function Compile_Init_Status (Analyze_Only : Boolean) return Integer is     begin        if Analyze_Only then -         return; +         return 0; +      end if; + +      if not Ghdllocal.Setup_Libraries (True) then +         return -1;        end if; -      Ghdllocal.Setup_Libraries (True); +      return 0; +   end Compile_Init_Status; + +   procedure Compile_Init (Analyze_Only : Boolean) is +   begin +      if Compile_Init_Status (Analyze_Only) /= 0 then +         raise Option_Error; +      end if;     end Compile_Init;     procedure Compile_Elab @@ -87,10 +98,22 @@ package body Libghdl is                           Disp_Long_Help'Access);     end Set_Hooks; -   procedure Analyze_Init is +   function Analyze_Init_Status return Integer is     begin        --  Load libraries... -      Compile_Init (False); +      if Compile_Init_Status (False) /= 0 then +         return -1; +      end if; + +      return 0; +   end Analyze_Init_Status; + +   procedure Analyze_Init is +   begin +      --  Deprecated +      if Analyze_Init_Status /= 0 then +         raise Option_Error; +      end if;     end Analyze_Init;     function Analyze_File (File : Thin_String_Ptr; Len : Natural) return Iir is diff --git a/src/vhdl/libghdl/libghdl.ads b/src/vhdl/libghdl/libghdl.ads index 7d69cde23..5326666b8 100644 --- a/src/vhdl/libghdl/libghdl.ads +++ b/src/vhdl/libghdl/libghdl.ads @@ -34,6 +34,9 @@ package Libghdl is     procedure Set_Exec_Prefix (Prefix : Thin_String_Ptr; Len : Natural);     --  To be called before Analyze_File to initialize analysis. +   function Analyze_Init_Status return Integer; + +   --  Deprecated.  Raise an exception in case of error.     procedure Analyze_Init;     --  Analyze one file. diff --git a/src/vhdl/translate/ortho_front.adb b/src/vhdl/translate/ortho_front.adb index 6d75e2826..d681157d9 100644 --- a/src/vhdl/translate/ortho_front.adb +++ b/src/vhdl/translate/ortho_front.adb @@ -540,7 +540,9 @@ package body Ortho_Front is     begin        if Nbr_Parse = 0 then           --  Initialize only once... -         Libraries.Load_Std_Library; +         if not Libraries.Load_Std_Library then +            raise Option_Error; +         end if;           --  Here, time_base can be set.           Translation.Initialize; | 
