Skip to content

Commit

Permalink
Merge branch 'leo/152-robustify' into 'master'
Browse files Browse the repository at this point in the history
Test.Stub: Robustify calls to LAL API

Closes #152

See merge request eng/ide/libadalang-tools!193
  • Loading branch information
leocreuse committed Mar 7, 2024
2 parents 5925945 + e46c754 commit d451934
Showing 1 changed file with 38 additions and 26 deletions.
64 changes: 38 additions & 26 deletions src/test-stub.adb
Expand Up @@ -150,13 +150,6 @@ package body Test.Stub is
function Requires_Body (N : Ada_Node) return Boolean;
-- Checks if a body sample should be created for an element

function Get_Declaration
(Elem : Subtype_Indication)
return Base_Type_Decl
is
(Elem.F_Name.P_Relative_Name.As_Name.P_Referenced_Decl.As_Base_Type_Decl);
-- Returns declaration of corresponding parameter type

-------------------------------
-- Setter package generation --
-------------------------------
Expand Down Expand Up @@ -2162,8 +2155,18 @@ package body Test.Stub is

function Can_Declare_Variable (Param_Type : Type_Expr) return Boolean is
Param_Type_Name : Libadalang.Analysis.Name;
Attr_Name : Identifier;
Attr_Name : Identifier;
Type_Decl : Base_Type_Decl;
begin
Type_Decl := Param_Type.P_Designated_Type_Decl;
if Type_Decl.Is_Null then
if not Quiet then
Report_Err
("Could not determine type referenced by "
& Param_Type.Image);
end if;
return False;
end if;

if Is_Only_Limited_Withed (Param_Type) then
return False;
Expand All @@ -2179,11 +2182,21 @@ package body Test.Stub is
end if;
end if;

return
Get_Declaration
(Param_Type.As_Subtype_Indication).P_Is_Definite_Subtype
(Param_Type);

return Type_Decl.P_Is_Definite_Subtype (Param_Type);
exception
when Ex : Property_Error =>
if not Verbose then
Trace
(Me,
"Could not determine if type " & Param_Type.Image
& " is definite");
else
Report_Err
("Could not determine if type " & Param_Type.Image
& " is definite, assuming it is not.");
end if;
Report_Ex (Ex);
return False;
end Can_Declare_Variable;

begin
Expand Down Expand Up @@ -2316,7 +2329,7 @@ package body Test.Stub is
Subtype_Ind := Param_Type.As_Subtype_Indication;
end if;

Type_Decl := Get_Declaration (Subtype_Ind);
Type_Decl := Subtype_Ind.P_Designated_Type_Decl;

if Type_Decl.Kind in Ada_Generic_Formal then
return False;
Expand Down Expand Up @@ -2367,7 +2380,7 @@ package body Test.Stub is
--------------------------

function Get_Access_Type_Name (Elem : Subtype_Indication) return String is
Decl : constant Base_Type_Decl := Get_Declaration (Elem);
Decl : constant Base_Type_Decl := Elem.P_Designated_Type_Decl;
Attr_Suff : constant String :=
(if Elem.F_Name.Kind = Ada_Attribute_Ref then
"_" & Node_Image (Elem.F_Name.As_Attribute_Ref.F_Attribute)
Expand All @@ -2390,7 +2403,7 @@ package body Test.Stub is
declare
S : String :=
Encode
(Decl.As_Basic_Decl.P_Fully_Qualified_Name,
(Decl.P_Defining_Name.P_Fully_Qualified_Name,
Decl.Unit.Get_Charset)
& Attr_Suff & "_Access";
begin
Expand Down Expand Up @@ -2438,7 +2451,7 @@ package body Test.Stub is
Subtype_Ind := Param_Type.As_Subtype_Indication;
end if;

Decl := Get_Declaration (Subtype_Ind);
Decl := Subtype_Ind.P_Designated_Type_Decl;

if To_Lower (Get_Nesting (Decl)) = "standard" then
return Overall_Image;
Expand Down Expand Up @@ -2527,7 +2540,7 @@ package body Test.Stub is
Subtype_Ind := Param_Type.As_Subtype_Indication;
end if;

Type_Decl := Get_Declaration (Subtype_Ind);
Type_Decl := Subtype_Ind.P_Designated_Type_Decl;

if Type_Decl.Kind in Ada_Generic_Formal then
return False;
Expand Down Expand Up @@ -2611,14 +2624,13 @@ package body Test.Stub is
Subtype_Ind := Param_Type.As_Subtype_Indication;
end if;

Type_Decl := Get_Declaration (Subtype_Ind).P_Canonical_Type;
Type_Decl := Subtype_Ind.P_Designated_Type_Decl.P_Canonical_Type;
if Type_Decl.Kind = Ada_Classwide_Type_Decl
and then Get_Declaration (Subtype_Ind).Kind = Ada_Subtype_Decl
and then Subtype_Ind.P_Designated_Type_Decl.Kind = Ada_Subtype_Decl
then
Type_Decl :=
Get_Declaration
(Subtype_Ind).As_Subtype_Decl.F_Subtype.F_Name.P_Relative_Name.
P_Referenced_Decl.As_Base_Type_Decl;
Subtype_Ind.P_Designated_Type_Decl.As_Subtype_Decl.F_Subtype
.P_Designated_Type_Decl;
end if;

while not Type_Decl.Is_Null loop
Expand Down Expand Up @@ -2678,7 +2690,7 @@ package body Test.Stub is
Subtype_Ind := Param_Type.As_Subtype_Indication;
end if;

Type_Decl := Get_Declaration (Subtype_Ind);
Type_Decl := Subtype_Ind.P_Designated_Type_Decl;

declare
Insts : constant Generic_Instantiation_Array :=
Expand Down Expand Up @@ -3109,7 +3121,7 @@ package body Test.Stub is

procedure Add_Unconstrained_Type_To_Dictionary (Elem : Subtype_Indication)
is
Encl : Ada_Node := Get_Declaration (Elem).As_Ada_Node;
Encl : Ada_Node := Elem.P_Designated_Type_Decl.As_Ada_Node;
Dict_Elem : Access_Dictionary_Entry;

D_Cur : Access_Dictionaries.Cursor;
Expand All @@ -3123,7 +3135,7 @@ package body Test.Stub is
Encl := Encl.Parent;
end loop;

Dict_Elem.Type_Decl := Get_Declaration (Elem).As_Ada_Node;
Dict_Elem.Type_Decl := Elem.P_Designated_Type_Decl.As_Ada_Node;

D_Cur := Dictionary.First;
while D_Cur /= Access_Dictionaries.No_Element loop
Expand Down

0 comments on commit d451934

Please sign in to comment.