172 lines
18 KiB
HTML
172 lines
18 KiB
HTML
<!DOCTYPE html>
|
|
<html><head>
|
|
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/>
|
|
<title>test.adb</title>
|
|
<meta name="generator" content="KF5::SyntaxHighlighting - Definition (Ada) - Theme (Breeze Light)"/>
|
|
</head><body style="background-color:#ffffff;color:#1f1c1b"><pre>
|
|
<span style="font-weight:bold">with</span> Ada<span style="color:#ca60ca">.</span>Containers<span style="color:#ca60ca">.</span>Vectors;
|
|
<span style="font-weight:bold">with</span> Ada<span style="color:#ca60ca">.</span>Strings; <span style="font-weight:bold">use</span> Ada<span style="color:#ca60ca">.</span>Strings;
|
|
<span style="font-weight:bold">with</span> Put_Title;
|
|
|
|
<span style="font-weight:bold">procedure</span> LAL_DDA <span style="font-weight:bold">is</span>
|
|
Collection <span style="color:#ca60ca">:</span> Repinfo_Collection;
|
|
|
|
A_Basic_Record <span style="color:#ca60ca">:</span> Basic_Record <span style="color:#ca60ca">:=</span> Basic_Record'<span style="color:#ca60ca">(</span>A <span style="color:#ca60ca">=></span> <span style="color:#b08000">42</span><span style="color:#ca60ca">)</span>;
|
|
Another_Basic_Record <span style="color:#ca60ca">:</span> Basic_Record <span style="color:#ca60ca">:=</span> <span style="color:#ca60ca">(</span>A <span style="color:#ca60ca">=></span> <span style="color:#b08000">42</span><span style="color:#ca60ca">)</span>;
|
|
Nix <span style="color:#ca60ca">:</span> <span style="font-weight:bold">constant</span> Null_Record <span style="color:#ca60ca">:=</span> <span style="color:#ca60ca">(</span><span style="font-weight:bold">null</span> <span style="font-weight:bold">record</span><span style="color:#ca60ca">)</span>;
|
|
|
|
<span style="font-weight:bold">procedure</span> Process_Type_Decl <span style="color:#ca60ca">(</span>Decl <span style="color:#ca60ca">:</span> Base_Type_Decl<span style="color:#ca60ca">)</span>;
|
|
<span style="color:#898887">-- Display all representation information that is available in</span>
|
|
<span style="color:#898887">-- ``Collection`` for this type declaration.</span>
|
|
|
|
<span style="font-weight:bold">procedure</span> Process_Variants
|
|
<span style="color:#ca60ca">(</span>Variants <span style="color:#ca60ca">:</span> Variant_Representation_Array; Prefix <span style="color:#ca60ca">:</span> <span style="color:#0057ae">String</span><span style="color:#ca60ca">)</span>;
|
|
<span style="color:#898887">-- Display all representation information for the given record variants.</span>
|
|
<span style="color:#898887">-- ``Prefix`` is used as a prefix for all printed lines.</span>
|
|
|
|
<span style="font-weight:bold">package</span> Expr_Vectors <span style="font-weight:bold">is</span> <span style="font-weight:bold">new</span> Ada<span style="color:#ca60ca">.</span>Containers<span style="color:#ca60ca">.</span>Vectors <span style="color:#ca60ca">(</span>Positive<span style="color:#ca60ca">,</span> Expr<span style="color:#ca60ca">)</span>;
|
|
<span style="font-weight:bold">use</span> <span style="font-weight:bold">type</span> Expr_Vectors<span style="color:#ca60ca">.</span>Vector;
|
|
<span style="font-weight:bold">package</span> Expr_Vector_Vectors <span style="font-weight:bold">is</span> <span style="font-weight:bold">new</span> Ada<span style="color:#ca60ca">.</span>Containers<span style="color:#ca60ca">.</span>Vectors
|
|
<span style="color:#ca60ca">(</span>Positive<span style="color:#ca60ca">,</span> Expr_Vectors<span style="color:#ca60ca">.</span>Vector<span style="color:#ca60ca">)</span>;
|
|
|
|
<span style="font-weight:bold">function</span> Test_Discriminants
|
|
<span style="color:#ca60ca">(</span>Decl <span style="color:#ca60ca">:</span> Base_Type_Decl<span style="color:#ca60ca">)</span> <span style="font-weight:bold">return</span> Expr_Vector_Vectors<span style="color:#ca60ca">.</span>Vector;
|
|
<span style="color:#898887">-- Fetch the vector of discriminants to use for testing from nearby Test</span>
|
|
<span style="color:#898887">-- pragmas.</span>
|
|
|
|
<span style="font-weight:bold">procedure</span> Error <span style="color:#ca60ca">(</span>Node <span style="color:#ca60ca">:</span> Ada_Node'Class; Message <span style="color:#ca60ca">:</span> <span style="color:#0057ae">String</span><span style="color:#ca60ca">)</span> <span style="font-weight:bold">with</span> <span style="color:#0095ff;font-weight:bold">No_Return</span>;
|
|
<span style="color:#898887">-- Abort the App with the given error ``Message``, contextualized using</span>
|
|
<span style="color:#898887">-- ``Node`` 's source location.</span>
|
|
|
|
<span style="font-weight:bold">package</span> App <span style="font-weight:bold">is</span> <span style="font-weight:bold">new</span> Libadalang<span style="color:#ca60ca">.</span>Helpers<span style="color:#ca60ca">.</span>App
|
|
<span style="color:#ca60ca">(</span>Name <span style="color:#ca60ca">=></span> <span style="color:#bf0303">"lal_dda"</span><span style="color:#ca60ca">,</span>
|
|
Description <span style="color:#ca60ca">=></span>
|
|
<span style="color:#bf0303">"Exercize Libadalang's Data_Decomposition API on type declarations"</span><span style="color:#ca60ca">,</span>
|
|
App_Setup <span style="color:#ca60ca">=></span> App_Setup<span style="color:#ca60ca">,</span>
|
|
Process_Unit <span style="color:#ca60ca">=></span> Process_Unit<span style="color:#ca60ca">)</span>;
|
|
|
|
<span style="font-weight:bold">package</span> Args <span style="font-weight:bold">is</span>
|
|
<span style="font-weight:bold">use</span> GNATCOLL<span style="color:#ca60ca">.</span>Opt_Parse;
|
|
|
|
<span style="font-weight:bold">package</span> Rep_Info_Files <span style="font-weight:bold">is</span> <span style="font-weight:bold">new</span> Parse_Option_List
|
|
<span style="color:#ca60ca">(</span>App<span style="color:#ca60ca">.</span>Args<span style="color:#ca60ca">.</span>Parser<span style="color:#ca60ca">,</span> <span style="color:#bf0303">"-i"</span><span style="color:#ca60ca">,</span> <span style="color:#bf0303">"--rep-info-file"</span><span style="color:#ca60ca">,</span>
|
|
Arg_Type <span style="color:#ca60ca">=></span> Unbounded_String<span style="color:#ca60ca">,</span>
|
|
Accumulate <span style="color:#ca60ca">=></span> True<span style="color:#ca60ca">,</span>
|
|
Help <span style="color:#ca60ca">=></span> <span style="color:#bf0303">"Output for the compiler's -gnatR4j option"</span><span style="color:#ca60ca">)</span>;
|
|
|
|
<span style="font-weight:bold">end</span> Args;
|
|
|
|
<span style="color:#898887">---------------</span>
|
|
<span style="color:#898887">-- App_Setup --</span>
|
|
<span style="color:#898887">---------------</span>
|
|
|
|
<span style="font-weight:bold">procedure</span> App_Setup <span style="color:#ca60ca">(</span>Context <span style="color:#ca60ca">:</span> App_Context; Jobs <span style="color:#ca60ca">:</span> App_Job_Context_Array<span style="color:#ca60ca">)</span> <span style="font-weight:bold">is</span>
|
|
<span style="font-weight:bold">pragma</span> Unreferenced <span style="color:#ca60ca">(</span>Context<span style="color:#ca60ca">,</span> Jobs<span style="color:#ca60ca">)</span>;
|
|
<span style="font-weight:bold">begin</span>
|
|
Collection <span style="color:#ca60ca">:=</span> Load <span style="color:#ca60ca">(</span>Filename_Array <span style="color:#ca60ca">(</span>Args<span style="color:#ca60ca">.</span>Rep_Info_Files<span style="color:#ca60ca">.</span>Get<span style="color:#ca60ca">))</span>;
|
|
<span style="font-weight:bold">exception</span>
|
|
<span style="font-weight:bold">when</span> Exc <span style="color:#ca60ca">:</span> Loading_Error <span style="color:#ca60ca">=></span>
|
|
Put_Line
|
|
<span style="color:#ca60ca">(</span><span style="color:#bf0303">"Loading_Error raised while loading representation information:"</span><span style="color:#ca60ca">)</span>;
|
|
Put_Line <span style="color:#ca60ca">(</span>Exception_Message <span style="color:#ca60ca">(</span>Exc<span style="color:#ca60ca">))</span>;
|
|
New_Line;
|
|
<span style="font-weight:bold">end</span> App_Setup;
|
|
|
|
<span style="color:#898887">------------------</span>
|
|
<span style="color:#898887">-- Process_Unit --</span>
|
|
<span style="color:#898887">------------------</span>
|
|
|
|
<span style="font-weight:bold">procedure</span> Process_Unit <span style="color:#ca60ca">(</span>Context <span style="color:#ca60ca">:</span> App_Job_Context; Unit <span style="color:#ca60ca">:</span> Analysis_Unit<span style="color:#ca60ca">)</span> <span style="font-weight:bold">is</span>
|
|
<span style="font-weight:bold">pragma</span> Unreferenced <span style="color:#ca60ca">(</span>Context<span style="color:#ca60ca">)</span>;
|
|
|
|
<span style="font-weight:bold">function</span> Process <span style="color:#ca60ca">(</span>Node <span style="color:#ca60ca">:</span> Ada_Node'Class<span style="color:#ca60ca">)</span> <span style="font-weight:bold">return</span> Visit_Status;
|
|
|
|
<span style="font-weight:bold">function</span> Process <span style="color:#ca60ca">(</span>Node <span style="color:#ca60ca">:</span> Ada_Node'Class<span style="color:#ca60ca">)</span> <span style="font-weight:bold">return</span> Visit_Status <span style="font-weight:bold">is</span>
|
|
<span style="font-weight:bold">begin</span>
|
|
<span style="font-weight:bold">case</span> Node<span style="color:#ca60ca">.</span>Kind <span style="font-weight:bold">is</span>
|
|
<span style="font-weight:bold">when</span> Ada_Base_Type_Decl <span style="color:#ca60ca">=></span>
|
|
Process_Type_Decl <span style="color:#ca60ca">(</span>Node<span style="color:#ca60ca">.</span>As_Base_Type_Decl<span style="color:#ca60ca">)</span>;
|
|
|
|
<span style="font-weight:bold">when</span> Ada_Pragma_Node <span style="color:#ca60ca">=></span>
|
|
<span style="font-weight:bold">declare</span>
|
|
PN <span style="color:#ca60ca">:</span> <span style="font-weight:bold">constant</span> Pragma_Node <span style="color:#ca60ca">:=</span> Node<span style="color:#ca60ca">.</span>As_Pragma_Node;
|
|
Name <span style="color:#ca60ca">:</span> <span style="font-weight:bold">constant</span> Text_Type <span style="color:#ca60ca">:=</span> To_Lower <span style="color:#ca60ca">(</span>PN<span style="color:#ca60ca">.</span>F_Id<span style="color:#ca60ca">.</span>Text<span style="color:#ca60ca">)</span>;
|
|
Decl <span style="color:#ca60ca">:</span> Ada_Node;
|
|
<span style="font-weight:bold">begin</span>
|
|
<span style="font-weight:bold">if</span> Name <span style="color:#ca60ca">=</span> <span style="color:#bf0303">"test_object_type"</span> <span style="font-weight:bold">then</span>
|
|
Decl <span style="color:#ca60ca">:=</span> PN<span style="color:#ca60ca">.</span>Previous_Sibling;
|
|
<span style="font-weight:bold">if</span> Decl<span style="color:#ca60ca">.</span>Kind <span style="color:#ca60ca">/=</span> Ada_Object_Decl <span style="font-weight:bold">then</span>
|
|
Error
|
|
<span style="color:#ca60ca">(</span>Node<span style="color:#ca60ca">,</span>
|
|
<span style="color:#bf0303">"previous declaration must be an object"</span>
|
|
<span style="color:#ca60ca">&</span> <span style="color:#bf0303">" declaration"</span><span style="color:#ca60ca">)</span>;
|
|
<span style="font-weight:bold">end if</span>;
|
|
Process_Type_Decl
|
|
<span style="color:#ca60ca">(</span>Decl<span style="color:#ca60ca">.</span>As_Object_Decl
|
|
<span style="color:#ca60ca">.</span>F_Type_Expr
|
|
<span style="color:#ca60ca">.</span>P_Designated_Type_Decl<span style="color:#ca60ca">)</span>;
|
|
<span style="font-weight:bold">end if</span>;
|
|
<span style="font-weight:bold">if</span> I <span style="color:#ca60ca">></span> <span style="color:#b08000">1</span> <span style="font-weight:bold">then</span>
|
|
Put <span style="color:#ca60ca">(</span><span style="color:#bf0303">", "</span><span style="color:#ca60ca">)</span>;
|
|
<span style="font-weight:bold">end if</span>;
|
|
<span style="font-weight:bold">end</span>;
|
|
|
|
<span style="font-weight:bold">when</span> <span style="font-weight:bold">others</span> <span style="color:#ca60ca">=></span>
|
|
<span style="font-weight:bold">null</span>;
|
|
<span style="font-weight:bold">end case</span>;
|
|
<span style="font-weight:bold">return</span> Into;
|
|
<span style="font-weight:bold">end</span> Process;
|
|
|
|
<span style="font-weight:bold">begin</span>
|
|
Put_Title
|
|
<span style="color:#ca60ca">(</span><span style="color:#924c9d">'#'</span><span style="color:#ca60ca">,</span> <span style="color:#bf0303">"Analyzing "</span> <span style="color:#ca60ca">&</span> Ada<span style="color:#ca60ca">.</span>Directories<span style="color:#ca60ca">.</span>Simple_Name <span style="color:#ca60ca">(</span>Unit<span style="color:#ca60ca">.</span>Get_Filename<span style="color:#ca60ca">))</span>;
|
|
<span style="font-weight:bold">if</span> Unit<span style="color:#ca60ca">.</span>Has_Diagnostics <span style="font-weight:bold">then</span>
|
|
<span style="font-weight:bold">for</span> D <span style="font-weight:bold">of</span> Unit<span style="color:#ca60ca">.</span>Diagnostics <span style="font-weight:bold">loop</span>
|
|
Put_Line <span style="color:#ca60ca">(</span>Unit<span style="color:#ca60ca">.</span>Format_GNU_Diagnostic <span style="color:#ca60ca">(</span>D<span style="color:#ca60ca">))</span>;
|
|
<span style="font-weight:bold">end loop</span>;
|
|
New_Line;
|
|
<span style="font-weight:bold">return</span>;
|
|
|
|
<span style="font-weight:bold">elsif</span> <span style="font-weight:bold">not</span> Unit<span style="color:#ca60ca">.</span>Root<span style="color:#ca60ca">.</span>Is_Null <span style="font-weight:bold">then</span>
|
|
Unit<span style="color:#ca60ca">.</span>Root<span style="color:#ca60ca">.</span>Traverse <span style="color:#ca60ca">(</span>Process'Access<span style="color:#ca60ca">)</span>;
|
|
<span style="font-weight:bold">end if</span>;
|
|
<span style="font-weight:bold">end</span> Process_Unit;
|
|
<span style="font-weight:bold">end</span> LAL_DDA;
|
|
|
|
<span style="font-weight:bold">type</span> Car <span style="font-weight:bold">is</span> <span style="font-weight:bold">record</span>
|
|
Identity <span style="color:#ca60ca">:</span> <span style="color:#0057ae">Long_Long_Integer</span>;
|
|
Number_Wheels <span style="color:#ca60ca">:</span> Positive <span style="font-weight:bold">range</span> <span style="color:#b08000">1</span> <span style="color:#ca60ca">..</span> <span style="color:#b08000">16#</span><span style="color:#b08000">FF</span><span style="color:#b08000">#</span><span style="color:#b08000">E1</span>;
|
|
Number_Wheels <span style="color:#ca60ca">:</span> Positive <span style="font-weight:bold">range</span> <span style="color:#b08000">16#</span><span style="color:#b08000">F.FF</span><span style="color:#b08000">#</span><span style="color:#b08000">E+2</span> <span style="color:#ca60ca">..</span> <span style="color:#b08000">2#</span><span style="color:#b08000">1111_1111</span><span style="color:#b08000">#</span>;
|
|
Paint <span style="color:#ca60ca">:</span> Color;
|
|
Horse_Power_kW <span style="color:#ca60ca">:</span> <span style="color:#0057ae">Float</span> <span style="font-weight:bold">range</span> <span style="color:#b08000">0.0</span> <span style="color:#ca60ca">..</span> <span style="color:#b08000">2_000.0</span>;
|
|
Consumption <span style="color:#ca60ca">:</span> <span style="color:#0057ae">Float</span> <span style="font-weight:bold">range</span> <span style="color:#b08000">0.0</span> <span style="color:#ca60ca">..</span> <span style="color:#b08000">100.0</span>;
|
|
<span style="font-weight:bold">end record</span>;
|
|
|
|
<span style="font-weight:bold">type</span> Null_Record <span style="font-weight:bold">is</span> <span style="font-weight:bold">null</span> <span style="font-weight:bold">record</span>;
|
|
|
|
<span style="font-weight:bold">type</span> Traffic_Light_Access <span style="font-weight:bold">is</span> <span style="font-weight:bold">access</span> Mutable_Variant_Record;
|
|
Any_Traffic_Light <span style="color:#ca60ca">:</span> Traffic_Light_Access <span style="color:#ca60ca">:=</span>
|
|
<span style="font-weight:bold">new</span> Mutable_Variant_Record;
|
|
Aliased_Traffic_Light <span style="color:#ca60ca">:</span> <span style="font-weight:bold">aliased</span> Mutable_Variant_Record;
|
|
|
|
<span style="font-weight:bold">pragma</span> <span style="color:#0095ff;font-weight:bold">Unchecked_Union</span> <span style="color:#ca60ca">(</span>Union<span style="color:#ca60ca">)</span>;
|
|
<span style="font-weight:bold">pragma</span> <span style="color:#0095ff;font-weight:bold">Convention</span> <span style="color:#ca60ca">(</span>C<span style="color:#ca60ca">,</span> Union<span style="color:#ca60ca">)</span>; <span style="color:#898887">-- optional</span>
|
|
|
|
<span style="font-weight:bold">type</span> Programmer <span style="font-weight:bold">is</span> <span style="font-weight:bold">new</span> Person
|
|
<span style="font-weight:bold">and</span> Printable
|
|
<span style="font-weight:bold">with</span>
|
|
<span style="font-weight:bold">record</span>
|
|
Skilled_In <span style="color:#ca60ca">:</span> Language_List;
|
|
<span style="font-weight:bold">end record</span>;
|
|
|
|
<span style="color:#b08000">3#</span><span style="color:#b08000">12.112</span><span style="color:#b08000">#</span><span style="color:#b08000">e3</span>
|
|
<span style="color:#b08000">3#</span><span style="color:#b08000">12.11</span> <span style="font-weight:bold">use</span>
|
|
<span style="color:#898887">-- ^ invalid</span>
|
|
<span style="color:#b08000">3#</span><span style="color:#b08000">12.2</span>3#e3
|
|
<span style="color:#898887">-- ^ invalid</span>
|
|
<span style="color:#b08000">3#</span><span style="color:#b08000">12.11</span>ds#
|
|
<span style="color:#898887">-- ^ invalid</span>
|
|
<span style="color:#b08000">1211</span>ds
|
|
<span style="color:#898887">-- ^ invalid</span>
|
|
</pre></body></html>
|