From: Michal Malý Date: Fri, 28 Nov 2014 20:35:53 +0000 (+0100) Subject: - Introduce RetCode type and use it as a return status instead of Boolean X-Git-Url: https://gitweb.devoid-pointer.net/?a=commitdiff_plain;h=3e3cd26b9187a50e324420c6760954c604afb8f7;p=Nine-Q.git - Introduce RetCode type and use it as a return status instead of Boolean - Catch unhandled exceptions in calls to Chem_Problem.Get_Assignment to prevent deadlocking --- diff --git a/src/face_generators/face_generator.adb b/src/face_generators/face_generator.adb index 8313280..f95104b 100644 --- a/src/face_generators/face_generator.adb +++ b/src/face_generators/face_generator.adb @@ -2,7 +2,7 @@ with Ada.Strings.Unbounded; package body Face_Generator is - function Generate_Index_Face(HTML: out HTML_Code) return Boolean is + function Generate_Index_Face(HTML: out HTML_Code) return RetCode is use AWS.Templates; Temp: HTML_Code; @@ -17,13 +17,13 @@ package body Face_Generator is Temp := Parse(Filename => "templates/footer.html", Cached => True); Append_HTML(Source => HTML, New_Item => Temp); - return True; + return OK; end Generate_Index_Face; function Generate_Face(Assignment: in Problem_Generator_Syswides.Assignment_Info.Map; Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; HTML: out HTML_Code; - Pr_ID: in String; Pr_Cat: in String) return Boolean is + Pr_ID: in String; Pr_Cat: in String) return RetCode is begin return Generate_Face_With_Answer(Assignment => Assignment, Parameters => Parameters, HTML => HTML, Answer_Message => To_UB_Text(""), Answer_Code => Problem_Generator_Syswides.Invalid_Answer, @@ -34,13 +34,13 @@ package body Face_Generator is Answer_Message: in UB_Text; Answer_Code: in Problem_Generator_Syswides.Answer_RetCode; Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; - HTML: out HTML_Code; Pr_ID: in String; Pr_Cat: in String) return Boolean is + HTML: out HTML_Code; Pr_ID: in String; Pr_Cat: in String) return RetCode is use Problem_Generator_Syswides; use Problem_Generator_Syswides.Assignment_Info; begin if Assignment.Find(PROBLEM_TYPE_KEY) = Assignment_Info.No_Element then - return False; + return E_NOTFOUND; end if; declare @@ -51,7 +51,7 @@ package body Face_Generator is elsif Problem_Type_Str = PROBLEM_TYPE_SOLUBILITY then return Generate_Face_Solubility(Assignment, Answer_Message, Answer_Code, Parameters, HTML, Pr_ID, Pr_Cat); else - return False; + return E_INVAL; end if; end; end Generate_Face_With_Answer; @@ -86,7 +86,7 @@ package body Face_Generator is Answer_Message: in UB_Text; Answer_Code: in Problem_Generator_Syswides.Answer_RetCode; Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; - HTML: out HTML_Code; Pr_ID: in String; Pr_Cat: in String) return Boolean is + HTML: out HTML_Code; Pr_ID: in String; Pr_Cat: in String) return RetCode is use AWS.Templates; use Problem_Generator_Syswides; use Problem_Generator_Syswides.Assignment_Info; @@ -146,14 +146,14 @@ package body Face_Generator is Temp := Parse(Filename => "templates/footer.html"); Append_HTML(Source => HTML, New_Item => Temp); - return True; + return OK; end Generate_Face_Acidobazic; function Generate_Face_Solubility(Assignment: in Problem_Generator_Syswides.Assignment_Info.Map; Answer_Message: in UB_Text; Answer_Code: in Problem_Generator_Syswides.Answer_RetCode; Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; - HTML: out HTML_Code; Pr_ID: in String; Pr_Cat: in String) return Boolean is + HTML: out HTML_Code; Pr_ID: in String; Pr_Cat: in String) return RetCode is use Ada.Strings.Unbounded; use AWS.Templates; use Problem_Generator_Syswides; @@ -198,7 +198,7 @@ package body Face_Generator is end if; if Parameters.Find(Solubility_Suite.PARAMETER_PROBLEM_SUBTYPE_KEY) = Parameters_Info.No_Element then -- This parameter must be always present - return False; + return E_INVAL; end if; P_Subtype := To_UB_Text(Parameters.Element(Solubility_Suite.PARAMETER_PROBLEM_SUBTYPE_KEY)); Insert(Translations_Params, Assoc(Solubility_Suite.PARAMETER_PROBLEM_SUBTYPE_KEY, Solubility_Suite.PARAMETER_PROBLEM_SUBTYPE_KEY)); @@ -216,31 +216,31 @@ package body Face_Generator is if P_Subtype = Solubility_Suite.PROBLEM_SUBTYPE_V_FROM_G_KS then -- Check that we have all necessary fields in the assignment if Assignment.Find(Solubility_Suite.X_STOCHIO_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; if Assignment.Find(Solubility_Suite.Z_STOCHIO_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; if Assignment.Find(Solubility_Suite.KS_INT_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; if Assignment.Find(Solubility_Suite.KS_DEC_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; if Assignment.Find(Solubility_Suite.KS_INT_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; if Assignment.Find(Solubility_Suite.SAMPLE_WEIGHT_INT_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; if Assignment.Find(Solubility_Suite.SAMPLE_WEIGHT_DEC_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; if Assignment.Find(Solubility_Suite.MOLAR_MASS_INT_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; if Assignment.Find(Solubility_Suite.MOLAR_MASS_DEC_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; Insert(Translations, Assoc(Solubility_Suite.X_STOCHIO_KEY, Assignment.Element(Solubility_Suite.X_STOCHIO_KEY))); @@ -258,31 +258,31 @@ package body Face_Generator is elsif P_Subtype = Solubility_Suite.PROBLEM_SUBTYPE_KS_FROM_G_V then -- Check that we have all necessary fields in the assignment if Assignment.Find(Solubility_Suite.X_STOCHIO_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; if Assignment.Find(Solubility_Suite.Z_STOCHIO_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; if Assignment.Find(Solubility_Suite.SAMPLE_VOLUME_INT_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; if Assignment.Find(Solubility_Suite.SAMPLE_VOLUME_DEC_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; if Assignment.Find(Solubility_Suite.SAMPLE_VOLUME_EXP_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; if Assignment.Find(Solubility_Suite.SAMPLE_WEIGHT_INT_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; if Assignment.Find(Solubility_Suite.SAMPLE_WEIGHT_DEC_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; if Assignment.Find(Solubility_Suite.MOLAR_MASS_INT_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; if Assignment.Find(Solubility_Suite.MOLAR_MASS_DEC_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; Insert(Translations, Assoc(Solubility_Suite.X_STOCHIO_KEY, Assignment.Element(Solubility_Suite.X_STOCHIO_KEY))); @@ -300,28 +300,28 @@ package body Face_Generator is elsif P_Subtype = Solubility_Suite.PROBLEM_SUBTYPE_C_FROM_KS_DIFFERENT_IONS or P_Subtype = Solubility_Suite.PROBLEM_SUBTYPE_C_FROM_KS_SHARED_ION then -- Check that we have all necessary fields in the assignment if Assignment.Find(Solubility_Suite.X_STOCHIO_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; if Assignment.Find(Solubility_Suite.Z_STOCHIO_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; if Assignment.Find(Solubility_Suite.EC_INT_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; if Assignment.Find(Solubility_Suite.EC_DEC_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; if Assignment.Find(Solubility_Suite.EC_EXP_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; if Assignment.Find(Solubility_Suite.KS_INT_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; if Assignment.Find(Solubility_Suite.KS_DEC_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; if Assignment.Find(Solubility_Suite.KS_INT_KEY) = Assignment_Info.No_Element then - return False; + return E_INVAL; end if; Insert(Translations, Assoc(Solubility_Suite.X_STOCHIO_KEY, Assignment.Element(Solubility_Suite.X_STOCHIO_KEY))); @@ -340,13 +340,13 @@ package body Face_Generator is end if; Append_HTML(Source => HTML, New_Item => Temp); else - return False; + return E_INVAL; end if; Temp := Parse(Filename => "templates/footer.html"); Append_HTML(Source => HTML, New_Item => Temp); - return True; + return OK; end Generate_Face_Solubility; end Face_Generator; diff --git a/src/face_generators/face_generator.ads b/src/face_generators/face_generator.ads index 9db16ca..894a392 100644 --- a/src/face_generators/face_generator.ads +++ b/src/face_generators/face_generator.ads @@ -4,19 +4,19 @@ with AWS.Templates; use Global_Types; package Face_Generator is - function Generate_Index_Face(HTML: out HTML_Code) return Boolean; + function Generate_Index_Face(HTML: out HTML_Code) return RetCode; function Generate_Face(Assignment: in Problem_Generator_Syswides.Assignment_Info.Map; Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; HTML: out HTML_Code; - Pr_ID: in String; Pr_Cat: in String) return Boolean; + Pr_ID: in String; Pr_Cat: in String) return RetCode; function Generate_Face_With_Answer(Assignment: in Problem_Generator_Syswides.Assignment_Info.Map; Answer_Message: in UB_Text; Answer_Code: in Problem_Generator_Syswides.Answer_RetCode; Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; HTML: out HTML_Code; - Pr_ID: in String; Pr_Cat: in String) return Boolean; + Pr_ID: in String; Pr_Cat: in String) return RetCode; private procedure Add_Answer_Section(Translations: in out AWS.Templates.Translate_Set; Answer_Message: in UB_Text; @@ -27,14 +27,14 @@ private Answer_Code: in Problem_Generator_Syswides.Answer_RetCode; Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; HTML: out HTML_Code; - Pr_ID: in String; Pr_Cat: in String) return Boolean; + Pr_ID: in String; Pr_Cat: in String) return RetCode; function Generate_Face_Solubility(Assignment: in Problem_Generator_Syswides.Assignment_Info.Map; Answer_Message: in UB_Text; Answer_Code: in Problem_Generator_Syswides.Answer_RetCode; Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; HTML: out HTML_Code; - Pr_ID: in String; Pr_Cat: in String) return Boolean; + Pr_ID: in String; Pr_Cat: in String) return RetCode; HEADER_CAPTION_KEY: constant String := "HEADER_CAPTION"; HINTS_SECTION_KEY: constant String := "HINTS_SECTION"; diff --git a/src/global_types.ads b/src/global_types.ads index adfca9c..d80f381 100644 --- a/src/global_types.ads +++ b/src/global_types.ads @@ -4,6 +4,7 @@ with Ada.Strings.Unbounded; package Global_Types is type Problem_ID is new Ada.Containers.Count_Type; + type RetCode is (OK, E_NOTFOUND, E_UNKW, E_INVAL, E_NOMEM, E_NULLPTR); type Unique_ID is new Ada.Containers.Count_Type; subtype HTML_Code is Ada.Strings.Unbounded.Unbounded_String; subtype UB_Text is Ada.Strings.Unbounded.Unbounded_String; diff --git a/src/handlers/handler_check_answer.adb b/src/handlers/handler_check_answer.adb index caa32e1..95b22f8 100644 --- a/src/handlers/handler_check_answer.adb +++ b/src/handlers/handler_check_answer.adb @@ -32,6 +32,7 @@ package body Handler_Check_Answer is POST_Data: constant AWS.Parameters.List := AWS.Status.Parameters(Request); Answer: Answer_Info.Map; Pr_ID: Problem_ID; + Ret: RetCode; Success: Boolean; begin -- Get UID @@ -68,8 +69,8 @@ package body Handler_Check_Answer is return AWS.Response.URL(Location => "/"); end; - Success := Problem_Manager.Display_Checked_Answer(UID, Answer, HTML, Pr_ID); - if Success = False then + Ret := Problem_Manager.Display_Checked_Answer(UID, Answer, HTML, Pr_ID); + if Ret /= OK then Ada.Text_IO.Put_Line("No such problem in storage"); return AWS.Response.URL(Location => "/"); end if; diff --git a/src/handlers/handler_default.adb b/src/handlers/handler_default.adb index f89fb29..1b01211 100644 --- a/src/handlers/handler_default.adb +++ b/src/handlers/handler_default.adb @@ -10,10 +10,10 @@ package body Handler_Default is function Handle(Request: AWS.Status.Data) return AWS.Response.Data is HTML: HTML_Code; - Success: Boolean; + Ret: RetCode; begin - Success := Face_Generator.Generate_Index_Face(HTML); - if Success = False then + Ret := Face_Generator.Generate_Index_Face(HTML); + if Ret /= OK then return AWS.Response.Build(Content_Type => AWS.MIME.Text_HTML, Message_Body => "Internal server error occured, we're sorry about that...", Status_Code => AWS.Messages.S503); diff --git a/src/handlers/handler_next_problem.adb b/src/handlers/handler_next_problem.adb index 84119ae..1ddbd19 100644 --- a/src/handlers/handler_next_problem.adb +++ b/src/handlers/handler_next_problem.adb @@ -32,6 +32,7 @@ package body Handler_Next_Problem is Problem_Parameters: Parameters_Info.Map; POST_Data: constant AWS.Parameters.List := AWS.Status.Parameters(Request); + Ret: RetCode; Success: Boolean; begin -- Get UID @@ -63,14 +64,14 @@ package body Handler_Next_Problem is declare Raw_P_Cat: constant String := Problem_Parameters.Element(Problem_Generator_Syswides.RESERVED_PROBLEM_CATEGORY_KEY); begin - Success := Problem_Manager.Prepare_Problem(UID, Raw_P_Cat, Problem_Parameters); - if Success = False then + Ret := Problem_Manager.Prepare_Problem(UID, Raw_P_Cat, Problem_Parameters); + if Ret /= OK then -- TODO: Handle error in a less reckless manner return AWS.Response.URL(Location => "/"); end if; -- Display new problem - Success := Problem_Manager.Display_Assignment(UID, HTML); - if Success = False then + Ret := Problem_Manager.Display_Assignment(UID, HTML); + if Ret /= OK then -- TODO: Handle error in a less reckless manner return AWS.Response.URL(Location => "/"); end if; diff --git a/src/handlers/handler_start.adb b/src/handlers/handler_start.adb index bda113c..6cbea1b 100644 --- a/src/handlers/handler_start.adb +++ b/src/handlers/handler_start.adb @@ -24,14 +24,15 @@ package body Handler_Start is declare Raw_Problem_Category: constant String := AWS.Status.Parameter(Request, "problem_category"); UID: Unique_ID; + Ret: RetCode; Success: Boolean; begin -- Register new UID if necessary and create a first problem Success := Problem_Manager.Get_UID(Raw_UID, UID); if Success = False then -- UID stored within this session is not valid, register a new one - Success := Problem_Manager.Register_UID(UID); - if Success = False then + Ret := Problem_Manager.Register_UID(UID); + if Ret /= OK then -- UID could not have been registered -- TODO: Print some sensible error message, for now just redirect to index return AWS.Response.URL(Location => "/"); @@ -42,15 +43,15 @@ package body Handler_Start is end if; -- We're all set, create a new problem - Success := Problem_Manager.Prepare_Problem(UID, Raw_Problem_Category); - if Success = False then + Ret := Problem_Manager.Prepare_Problem(UID, Raw_Problem_Category); + if Ret /= OK then -- Something went wrong when generating the problem -- TODO: Print some sensible error message, for now just redirect to index return AWS.Response.URL(Location => "/"); end if; - Success := Problem_Manager.Display_Assignment(UID, HTML); - if Success = False then + Ret := Problem_Manager.Display_Assignment(UID, HTML); + if Ret /= OK then HTML := To_HTML_Code("Cannot display assignment"); end if; return AWS.Response.Build(Content_Type => AWS.MIME.Text_HTML, diff --git a/src/problem_generators/problem_generator-acidobazic_suite.adb b/src/problem_generators/problem_generator-acidobazic_suite.adb index f87e775..cde1cd6 100644 --- a/src/problem_generators/problem_generator-acidobazic_suite.adb +++ b/src/problem_generators/problem_generator-acidobazic_suite.adb @@ -87,7 +87,7 @@ package body Acidobazic_Suite is end if; end Check_Answer; - function Get_Assignment(Problem: in out Acidobazic_Problem; Assignment: in out Assignment_Info.Map) return Boolean is + function Get_Assignment(Problem: in out Acidobazic_Problem; Assignment: in out Assignment_Info.Map) return RetCode is Guard: Auto_Lock.LC; C: Assignment_Info.Cursor; Success: Boolean; @@ -98,7 +98,7 @@ package body Acidobazic_Suite is Assignment.Insert(PROBLEM_TYPE_KEY, PROBLEM_TYPE_ACIDOBAZIC, C, Success); if Success = False then - return False; + return E_NOMEM; end if; case Problem.Subst_Type is when Acid => @@ -121,7 +121,7 @@ package body Acidobazic_Suite is Assignment.Insert(PKX_VALUE_INT_KEY, UB_Text_To_Fixed_String(Int_S), C, Success); Assignment.Insert(PKX_VALUE_DEC_KEY, UB_Text_To_Fixed_String(Dec_S), C, Success); if Success = False then - return False; + return E_NOMEM; end if; end; @@ -138,14 +138,14 @@ package body Acidobazic_Suite is Assignment.Insert(CONCENTRATION_DEC_KEY, UB_Text_To_Fixed_String(Dec_S), C, Success); Assignment.Insert(CONCENTRATION_EXP_KEY, UB_Text_To_Fixed_String(Exp_S), C, Success); if Success = False then - return False; + return E_NOMEM; end if; end; - return True; + return OK; end Get_Assignment; - function Get_Parameters(Problem: in out Acidobazic_Problem; Parameters: out Parameters_Info.Map) return Boolean is + function Get_Parameters(Problem: in out Acidobazic_Problem; Parameters: out Parameters_Info.Map) return RetCode is Guard: Auto_Lock.LC; C: Parameters_Info.Cursor; Success: Boolean; @@ -155,9 +155,11 @@ package body Acidobazic_Suite is if Problem.Parameters.No_Both_Simplifications then Parameters.Insert(PARAMETER_NO_BOTH_SIMPLIFICATIONS_KEY, "True", C, Success); - return Success; + if Success = False then + return E_NOMEM; + end if; end if; - return True; + return OK; end Get_Parameters; procedure New_Problem(Problem: in out Acidobazic_Problem) is @@ -181,7 +183,7 @@ package body Acidobazic_Suite is Random_Substance_Type_Gen.Reset(Gen => ST_G); Problem.Subst_Type := Random_Substance_Type_Gen.Random(Gen => ST_G); -- What simplification to use - if (Problem.Parameters.No_Both_Simplifications = False) then + if Problem.Parameters.No_Both_Simplifications = False then declare package Random_Simplification_Gen is new Ada.Numerics.Discrete_Random(Result_Subtype => Simplification); SIM_G: Random_Simplification_Gen.Generator; @@ -210,7 +212,7 @@ package body Acidobazic_Suite is Problem.cX := Random_cX(cX_Min, cX_Max); end New_Problem; - function Set_Parameters(Problem: in out Acidobazic_Problem; Parameters: in Parameters_Info.Map) return Boolean is + function Set_Parameters(Problem: in out Acidobazic_Problem; Parameters: in Parameters_Info.Map) return RetCode is use Parameters_Info; Guard: Auto_Lock.LC; @@ -224,7 +226,7 @@ package body Acidobazic_Suite is Problem.Parameters.No_Both_Simplifications := True; end if; - return True; + return OK; end Set_Parameters; -- END: Inherited functions diff --git a/src/problem_generators/problem_generator-solubility_suite.adb b/src/problem_generators/problem_generator-solubility_suite.adb index f574d22..d2876da 100644 --- a/src/problem_generators/problem_generator-solubility_suite.adb +++ b/src/problem_generators/problem_generator-solubility_suite.adb @@ -69,7 +69,7 @@ package body Solubility_Suite is end if; end Check_Answer; - function Get_Assignment(Problem: in out Solubility_Problem; Assignment: in out Assignment_Info.Map) return Boolean is + function Get_Assignment(Problem: in out Solubility_Problem; Assignment: in out Assignment_Info.Map) return RetCode is package FH is new Formatting_Helpers(SS_Float); use FH; @@ -115,7 +115,7 @@ package body Solubility_Suite is Assignment.Insert(KS_DEC_KEY, UB_Text_To_Fixed_String(Ks_Str_Dec)); Assignment.Insert(KS_EXP_KEY, UB_Text_To_Fixed_String(Ks_Str_Exp)); - return True; + return OK; end; when KS_FROM_G_V => declare @@ -138,7 +138,7 @@ package body Solubility_Suite is Assignment.Insert(SAMPLE_VOLUME_INT_KEY, UB_Text_To_Fixed_String(V_Str_Int)); Assignment.Insert(SAMPLE_VOLUME_DEC_KEY, UB_Text_To_Fixed_String(V_Str_Dec)); Assignment.Insert(SAMPLE_VOLUME_EXP_KEY, UB_Text_To_Fixed_String(V_Str_Exp)); - return True; + return OK; end; when C_FROM_KS_DIFFERENT_IONS | C_FROM_KS_SHARED_ION => declare @@ -158,12 +158,12 @@ package body Solubility_Suite is Assignment.Insert(KS_INT_KEY, UB_Text_To_Fixed_String(Ks_Str_Int)); Assignment.Insert(KS_DEC_KEY, UB_Text_To_Fixed_String(Ks_Str_Dec)); Assignment.Insert(KS_EXP_KEY, UB_Text_To_Fixed_String(Ks_Str_Exp)); - return True; + return OK; end; end case; end Get_Assignment; - function Get_Parameters(Problem: in out Solubility_Problem; Parameters: out Parameters_Info.Map) return Boolean is + function Get_Parameters(Problem: in out Solubility_Problem; Parameters: out Parameters_Info.Map) return RetCode is Guard: Auto_Lock.LC; C: Parameters_Info.Cursor; Success: Boolean; @@ -174,13 +174,15 @@ package body Solubility_Suite is if Problem.Parameters.Ionic_Strength then Parameters.Insert(PARAMETER_IONIC_STRENGTH_KEY, "True", C, Success); if Success = False then - return False; + return E_NOMEM; end if; end if; Parameters.Insert(PARAMETER_PROBLEM_SUBTYPE_KEY, Problem_Subtype'Image(Problem.Parameters.P_Subtype), C, Success); - - return Success; + if Success = False then + return E_NOMEM; + end if; + return OK; end Get_Parameters; procedure New_Problem(Problem: in out Solubility_Problem) is @@ -296,7 +298,7 @@ package body Solubility_Suite is Problem.Answer_Num := Answer_Num; end New_Problem; - function Set_Parameters(Problem: in out Solubility_Problem; Parameters: in Parameters_Info.Map) return Boolean is + function Set_Parameters(Problem: in out Solubility_Problem; Parameters: in Parameters_Info.Map) return RetCode is use Parameters_Info; Guard: Auto_Lock.LC; @@ -324,15 +326,15 @@ package body Solubility_Suite is elsif PS_Str = PROBLEM_SUBTYPE_C_FROM_KS_SHARED_ION then Problem.Parameters.P_Subtype := C_FROM_KS_SHARED_ION; else - raise Constraint_Error; + return E_INVAL; end if; end; else -- This parameter must be always present - return False; + return E_INVAL; end if; - return True; + return OK; end Set_Parameters; -- END: Inherited functions diff --git a/src/problem_generators/problem_generator.ads b/src/problem_generators/problem_generator.ads index b63e101..c9b0b5b 100644 --- a/src/problem_generators/problem_generator.ads +++ b/src/problem_generators/problem_generator.ads @@ -9,10 +9,10 @@ package Problem_Generator is function Create return access Chem_Problem is abstract; function Check_Answer(Problem: in out Chem_Problem; Answer: in Answer_Info.Map; Message: out UB_Text) return Answer_RetCode is abstract; - function Get_Assignment(Problem: in out Chem_Problem; Assignment: in out Assignment_Info.Map) return Boolean is abstract; - function Get_Parameters(Problem: in out Chem_Problem; Parameters: out Parameters_Info.Map) return Boolean is abstract; + function Get_Assignment(Problem: in out Chem_Problem; Assignment: in out Assignment_Info.Map) return RetCode is abstract; + function Get_Parameters(Problem: in out Chem_Problem; Parameters: out Parameters_Info.Map) return RetCode is abstract; procedure New_Problem(Problem: in out Chem_Problem) is abstract; - function Set_Parameters(Problem: in out Chem_Problem; Parameters: in Parameters_Info.Map) return Boolean is abstract; + function Set_Parameters(Problem: in out Chem_Problem; Parameters: in Parameters_Info.Map) return RetCode is abstract; function Get_Problem(P_Type: in Problem_Type) return access Chem_Problem'Class; @@ -45,9 +45,9 @@ private -- Inherited function Check_Answer(Problem: in out Acidobazic_Problem; Answer: in Answer_Info.Map; Message: out UB_Text) return Answer_RetCode; procedure New_Problem(Problem: in out Acidobazic_Problem); - function Get_Assignment(Problem: in out Acidobazic_Problem; Assignment: in out Assignment_Info.Map) return Boolean; - function Get_Parameters(Problem: in out Acidobazic_Problem; Parameters: out Parameters_Info.Map) return Boolean; - function Set_Parameters(Problem: in out Acidobazic_Problem; Parameters: in Parameters_Info.Map) return Boolean; + function Get_Assignment(Problem: in out Acidobazic_Problem; Assignment: in out Assignment_Info.Map) return RetCode; + function Get_Parameters(Problem: in out Acidobazic_Problem; Parameters: out Parameters_Info.Map) return RetCode; + function Set_Parameters(Problem: in out Acidobazic_Problem; Parameters: in Parameters_Info.Map) return RetCode; private type pH_Float is digits 15; @@ -107,9 +107,9 @@ private -- Inherited function Check_Answer(Problem: in out Solubility_Problem; Answer: in Answer_Info.Map; Message: out UB_Text) return Answer_RetCode; procedure New_Problem(Problem: in out Solubility_Problem); - function Get_Assignment(Problem: in out Solubility_Problem; Assignment: in out Assignment_Info.Map) return Boolean; - function Get_Parameters(Problem: in out Solubility_Problem; Parameters: out Parameters_Info.Map) return Boolean; - function Set_Parameters(Problem: in out Solubility_Problem; Parameters: in Parameters_Info.Map) return Boolean; + function Get_Assignment(Problem: in out Solubility_Problem; Assignment: in out Assignment_Info.Map) return RetCode; + function Get_Parameters(Problem: in out Solubility_Problem; Parameters: out Parameters_Info.Map) return RetCode; + function Set_Parameters(Problem: in out Solubility_Problem; Parameters: in Parameters_Info.Map) return RetCode; private type SS_Float is digits 17; diff --git a/src/problem_manager.adb b/src/problem_manager.adb index f872a36..d4f6f1f 100644 --- a/src/problem_manager.adb +++ b/src/problem_manager.adb @@ -4,33 +4,38 @@ with Face_Generator; package body Problem_Manager is - function Display_Checked_Answer(UID: in Unique_ID; Answer: in Problem_Generator_Syswides.Answer_Info.Map; HTML: out HTML_Code; Pr_ID: in Problem_ID) return Boolean is + function Display_Checked_Answer(UID: in Unique_ID; Answer: in Problem_Generator_Syswides.Answer_Info.Map; HTML: out HTML_Code; Pr_ID: in Problem_ID) return RetCode is Answer_Message: UB_Text; ARC: Problem_Generator_Syswides.Answer_RetCode; Assignment: Problem_Generator_Syswides.Assignment_Info.Map; Parameters: Problem_Generator_Syswides.Parameters_Info.Map; Pr_Cat: Problem_Category; - Success: Boolean; + Ret: RetCode; Stored: Stored_Problem_All_Access; begin Stored := Active_Sessions.Get_Problem(UID, Pr_ID); if Stored = null then - return False; + return E_NOTFOUND; end if; - Success := Stored.Problem.Get_Parameters(Parameters); - if Success = False then - -- TODO: Handle error in a better way + Ret := Stored.Problem.Get_Parameters(Parameters); + if Ret /= OK then Stored.Mutex.Unlock; - return False; - end if; - Success := Stored.Problem.Get_Assignment(Assignment); - if Success = False then - -- TODO: Handle error in a better way - Stored.Mutex.Unlock; - return False; + return Ret; end if; + begin + Ret := Stored.Problem.Get_Assignment(Assignment); + if Ret /= OK then + Stored.Mutex.Unlock; + return Ret; + end if; + exception + when others => + Stored.Mutex.Unlock; + return E_UNKW; + end; + ARC := Stored.Problem.Check_Answer(Answer, Answer_Message); Pr_Cat := Stored.Category; Stored.Mutex.Unlock; @@ -39,31 +44,37 @@ package body Problem_Manager is Parameters => Parameters, Pr_ID => Problem_ID'Image(Pr_ID), Pr_Cat => Problem_Category'Image(Pr_Cat)); end Display_Checked_Answer; - function Display_Assignment(UID: in Unique_ID; HTML: out HTML_Code) return Boolean is + function Display_Assignment(UID: in Unique_ID; HTML: out HTML_Code) return RetCode is Assignment: Problem_Generator_Syswides.Assignment_Info.Map; Parameters: Problem_Generator_Syswides.Parameters_Info.Map; Stored: Stored_Problem_All_Access; Pr_ID: Problem_ID; Pr_Cat: Problem_Category; - Success: Boolean; + Ret: RetCode; begin Stored := Active_Sessions.Get_Latest_Problem_With_ID(UID, Pr_ID); if Stored = null then - return False; + return E_NOTFOUND; end if; - Success := Stored.Problem.Get_Parameters(Parameters); - if Success = False then + Ret := Stored.Problem.Get_Parameters(Parameters); + if Ret /= OK then Stored.Mutex.Unlock; - return False; + return Ret; end if; -- Get assignment - Success := Stored.Problem.Get_Assignment(Assignment); - if Success = False then - Stored.Mutex.Unlock; - return False; - end if; + begin + Ret := Stored.Problem.Get_Assignment(Assignment); + if Ret /= OK then + Stored.Mutex.Unlock; + return Ret; + end if; + exception + when others => + Stored.Mutex.Unlock; + return E_UNKW; + end; Pr_Cat := Stored.Category; Stored.Mutex.Unlock; @@ -83,18 +94,18 @@ package body Problem_Manager is end Get_UID; function Prepare_Problem(UID: in Unique_ID; Raw_P_Cat: in String; - Parameters: in Problem_Generator_Syswides.Parameters_Info.Map := Problem_Generator_Syswides.Parameters_Info.Empty_Map) return Boolean is + Parameters: in Problem_Generator_Syswides.Parameters_Info.Map := Problem_Generator_Syswides.Parameters_Info.Empty_Map) return RetCode is Problem: Chem_Problem_All_Access; Storage: Stored_Problem_All_Access; P_Cat: Problem_Category; - Success: Boolean; + Ret: RetCode; begin if Raw_P_Cat = Problem_Manager.Problem_Category'Image(Problem_Manager.Acidobazic) then P_Cat := Problem_Manager.Acidobazic; elsif Raw_P_Cat = Problem_Manager.Problem_Category'Image(Problem_Manager.Solubility) then P_Cat := Problem_Manager.Solubility; else - return False; + return E_INVAL; end if; case P_Cat is @@ -103,48 +114,53 @@ package body Problem_Manager is when Solubility => Problem := Problem_Generator.Get_Problem(Problem_Generator_Syswides.Solubility); when others => - return False; + return E_INVAL; end case; if Problem = null then - return False; + return E_NULLPTR; end if; -- Initialize problem if Parameters.Is_Empty = False then - Success := Problem.Set_Parameters(Parameters); - if Success = False then + Ret := Problem.Set_Parameters(Parameters); + if Ret /= OK then Free_Chem_Problem(Problem); - return False; + return Ret; end if; end if; - Problem.New_Problem; + + begin + Problem.New_Problem; + exception + when others => + Free_Chem_Problem(Problem); + return E_UNKW; + end; Storage := new Stored_Problem; Storage.Problem := Problem; Storage.Category := P_Cat; - Active_Sessions.Add_Problem(UID, Storage, Success); + Active_Sessions.Add_Problem(UID, Storage, Ret); - if Success = False then + if Ret /= OK then Free_Chem_Problem(Problem); Free_Stored_Problem(Storage); end if; - return True; + return Ret; end Prepare_Problem; - function Register_UID(UID: out Unique_ID) return Boolean is - Success: Boolean; + function Register_UID(UID: out Unique_ID) return RetCode is + Ret: RetCode; begin - Active_Sessions.Register_UID(UID, Success); - return Success; + Active_Sessions.Register_UID(UID, Ret); + return Ret; end Register_UID; procedure Session_Expired(SID: in AWS.Session.ID) is Raw_UID: constant String := AWS.Session.Get(SID, "UID"); UID: Unique_ID; - Success: Boolean; begin - Success := Get_UID(Raw_UID, UID); - if Success = False then + if Get_UID(Raw_UID, UID) = False then return; end if; @@ -167,22 +183,24 @@ package body Problem_Manager is protected body Active_Sessions is - procedure Add_Problem(UID: in Unique_ID; Problem: in Stored_Problem_All_Access; Success: out Boolean) is + procedure Add_Problem(UID: in Unique_ID; Problem: in Stored_Problem_All_Access; Ret: out RetCode) is use Problem_Storage; use Session_Keeping; use Ada.Containers; C: Problem_Storage.Cursor; + Success: Boolean; USD: User_Session_All_Access; begin if Sessions.Find(UID) = Session_Keeping.No_Element then - Success := False; + Ret := E_NOTFOUND; return; end if; USD := Sessions.Element(UID); USD.Problems.Insert(USD.Last_Problem_ID, Problem, C, Success); if Success = False then + Ret := E_NOMEM; return; end if; @@ -211,7 +229,7 @@ package body Problem_Manager is end; end if; end; - Success := True; + Ret := OK; end Add_Problem; function Contains(UID: in Unique_ID) return Boolean is @@ -224,34 +242,38 @@ package body Problem_Manager is end if; end Contains; - procedure Check_Free_And_Register(UID: in Unique_ID; Success: out Boolean; Stop: out Boolean) is + procedure Check_Free_And_Register(UID: in Unique_ID; Ret: out RetCode; Stop: out Boolean) is use Session_Keeping; C: Session_Keeping.Cursor; NUSD: User_Session_All_Access; + Success: Boolean; begin - Success := False; if Sessions.Find(UID) = Session_Keeping.No_Element then -- We have a free slot NUSD := new User_Session_Data; if NUSD = null then - Success := False; - Stop := False; + -- Session data not allocated + Ret := E_NOMEM; + Stop := True; return; end if; Sessions.Insert(UID, NUSD, C, Success); if Success then Last_UID := UID; -- Registration successful + Ret := OK; Stop := True; return; else -- Registration failed + Ret := E_NOMEM; Stop := True; return; end if; end if; -- Slot occupied, keep looking + Ret := OK; Stop := False; end Check_Free_And_Register; @@ -303,12 +325,12 @@ package body Problem_Manager is return Get_Problem(UID, Pr_ID); end Get_Latest_Problem_With_ID; - procedure Register_UID(UID: out Unique_ID; Success: out Boolean) is + procedure Register_UID(UID: out Unique_ID; Ret: out RetCode) is Stop: Boolean; begin -- Look for an available UID slot for Idx in Last_UID .. Unique_ID'Last loop - Check_Free_And_Register(Idx, Success, Stop); + Check_Free_And_Register(Idx, Ret, Stop); if Stop then UID := Idx; return; @@ -317,7 +339,7 @@ package body Problem_Manager is -- We found no free slot above, search the area below Last_UID for Idx in Unique_ID'First .. Last_UID loop - Check_Free_And_Register(Idx, Success, Stop); + Check_Free_And_Register(Idx, Ret, Stop); if Stop then UID := Idx; return; @@ -325,7 +347,7 @@ package body Problem_Manager is end loop; -- There are no free slots available - Success := False; + Ret := E_NOMEM; end Register_UID; procedure Remove_Session(UID: in Unique_ID) is diff --git a/src/problem_manager.ads b/src/problem_manager.ads index 542d731..5fccf1e 100644 --- a/src/problem_manager.ads +++ b/src/problem_manager.ads @@ -10,15 +10,15 @@ package Problem_Manager is type Problem_Category is (Invalid, Acidobazic, Solubility); function Display_Checked_Answer(UID: in Unique_ID; Answer: in Problem_Generator_Syswides.Answer_Info.Map; HTML: out HTML_Code; - Pr_ID: in Problem_ID) return Boolean; - function Display_Assignment(UID: in Unique_ID; HTML: out HTML_Code) return Boolean; + Pr_ID: in Problem_ID) return RetCode; + function Display_Assignment(UID: in Unique_ID; HTML: out HTML_Code) return RetCode; --function Display_Next_Assignment(UID: in Unique_ID; -- Problem_Parameters: in Problem_Generator_Syswides.Parameters_Info.Map; -- HTML: out HTML_Code) return Boolean; function Get_UID(Raw_UID: in String; UID: out Unique_ID) return Boolean; function Prepare_Problem(UID: in Unique_ID; Raw_P_Cat: in String; - Parameters: in Problem_Generator_Syswides.Parameters_Info.Map := Problem_Generator_Syswides.Parameters_Info.Empty_Map) return Boolean; - function Register_UID(UID: out Unique_ID) return Boolean; + Parameters: in Problem_Generator_Syswides.Parameters_Info.Map := Problem_Generator_Syswides.Parameters_Info.Empty_Map) return RetCode; + function Register_UID(UID: out Unique_ID) return RetCode; procedure Session_Expired(SID: AWS.Session.ID); private @@ -46,15 +46,15 @@ private package Session_Keeping is new Ada.Containers.Ordered_Maps(Key_Type => Unique_ID, Element_Type => User_Session_All_Access); protected Active_Sessions is - procedure Add_Problem(UID: in Unique_ID; Problem: in Stored_Problem_All_Access; Success: out Boolean); + procedure Add_Problem(UID: in Unique_ID; Problem: in Stored_Problem_All_Access; Ret: out RetCode); function Contains(UID: in Unique_ID) return Boolean; function Get_Problem(UID: in Unique_ID; Pr_ID: in Problem_ID) return Stored_Problem_All_Access; function Get_Latest_Problem_With_ID(UID: in Unique_ID; Pr_ID: out Problem_ID) return Stored_Problem_All_Access; - procedure Register_UID(UID: out Unique_ID; Success: out Boolean); + procedure Register_UID(UID: out Unique_ID; Ret: out RetCode); procedure Remove_Session(UID: in Unique_ID); private - procedure Check_Free_And_Register(UID: in Unique_ID; Success: out Boolean; Stop: out Boolean); + procedure Check_Free_And_Register(UID: in Unique_ID; Ret: out RetCode; Stop: out Boolean); procedure Free_Session_Data(Data: in out User_Session_All_Access); Sessions: Session_Keeping.Map;